Find and tranfere values
 

Hi
I use find, findnext and search in a difrent workbook and when i got the
addresse I need to get non-contiguos cells values and past/transfer to
the active worksheet, I am usige
rngA = c.address
rngF = "F" & mid(c.address,4)
activecell = workbooks("A").range(rngA).value
activecell.offset(0,1) = workbooks("A").range(rngA).value, but is there
quiker methode to do this.

regards evgny

Find and tranfere values
 

Possibly using an autofilter, but it would require knowledge of how your
data is laid out (and where), what you are looking for (values in a single
column) and what you want to copy.

--
Regards,
Tom Ogilvy

"evgny" wrote in message
...
Hi
I use find, findnext and search in a difrent workbook and when i got the
addresse I need to get non-contiguos cells values and past/transfer to
the active worksheet, I am usige
rngA = c.address
rngF = "F" & mid(c.address,4)
activecell = workbooks("A").range(rngA).value
activecell.offset(0,1) = workbooks("A").range(rngA).value, but is there
quiker methode to do this.

regards evgny

Find and tranfere values
 

Thangs for the answer, Sorry that the my answer i late.
I am looking at collumns A, some time "string" and some time "values"
Look in: Workbook( "Per").worksheets("A").columns."A:A") This workbook is
open, but not active.
columns is like this.
A B C D E F
G
IdNr Ordre Date Text Text Text
Number
41301 610253#1 25.08.04 ...... ...... ...... 2
41301 610253#1 29.08.04 ...... ...... ...... 2
A2501 272834 12.10.04 ...... ...... ...... 18
If there is more then one, they are sortet by Date
Sub b()
Range("b2").Select
With Workbook( "Per"). Worksheets("A").Columns("A:A")
Dim c As Variant
Dim firstAddress As Variant

Set c = .Find(41301, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Dim rngA As Variant
Dim rngB As Variant
Dim rngC As Variant
Dim rngG As Variant
rngA = c.address
rngB = "B" & mid(c.address,4)
rngC = "C" & mid(c.address,4)
rngG = "G" & mid(c.address,4)

activecell = Workbook( "Per"). Worksheets("A").range(rngA).value
activecell.offset(0,1) = Workbook( "Per").workbooks("A").rang(rngB).value
activecell.offset(0,2) = Workbook( "Per").workbooks("A").rang(rngC).value
activecell.offset(0,3) = Workbook( "Per").workbooks("A").rang(rngG).value


ActiveCell.Offset(1, 0).Select


Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With
End Sub

I hope this is enough information.

Regard evgny


"Tom Ogilvy" wrote:

Possibly using an autofilter, but it would require knowledge of how your
data is laid out (and where), what you are looking for (values in a single
column) and what you want to copy.

--
Regards,
Tom Ogilvy

"evgny" wrote in message
...
Hi
I use find, findnext and search in a difrent workbook and when i got the
addresse I need to get non-contiguos cells values and past/transfer to
the active worksheet, I am usige
rngA = c.address
rngF = "F" & mid(c.address,4)
activecell = workbooks("A").range(rngA).value
activecell.offset(0,1) = workbooks("A").range(rngA).value, but is there
quiker methode to do this.

regards evgny

Find and tranfere values
 

Sub GetData()
Workbooks("Per.xls").Worksheets("A").Activate
If ActiveCell.Row = 1 Then
MsgBox "Activecell Can't be in Row 1"
Exit Sub
End If
With Workbooks("Per.xls").Worksheets("A")
If Not Intersect(.Range("a1").CurrentRegion, ActiveCell) _
Is Nothing Then
MsgBox "ActiveCell is in the source data - no place" & _
vbNewLine & " to put the results"
Exit Sub
End If
.Range("IV1").Value = .Range("A1").Value
.Range("IV2").Value = 41301
ActiveCell.Offset(-1, 0).Resize(1, 3).Value = _
.Range("A1:C1").Value
ActiveCell.Offset(-1, 3).Value = .Range("G1").Value
.Range("A1").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Range("IV1:IV2"), _
CopyToRange:=ActiveCell.Offset(-1, 0).Resize(1, 4), _
Unique:=False
.Columns(256).Delete
End With

End Sub

--
Regards,
Tom Ogilvy

"evgny" wrote in message
...
Thangs for the answer, Sorry that the my answer i late.
I am looking at collumns A, some time "string" and some time "values"
Look in: Workbook( "Per").worksheets("A").columns."A:A") This workbook is
open, but not active.
columns is like this.
A B C D E F
G
IdNr Ordre Date Text Text Text
Number
41301 610253#1 25.08.04 ...... ...... ...... 2
41301 610253#1 29.08.04 ...... ...... ...... 2
A2501 272834 12.10.04 ...... ...... ......
18
If there is more then one, they are sortet by Date
Sub b()
Range("b2").Select
With Workbook( "Per"). Worksheets("A").Columns("A:A")
Dim c As Variant
Dim firstAddress As Variant

Set c = .Find(41301, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Dim rngA As Variant
Dim rngB As Variant
Dim rngC As Variant
Dim rngG As Variant
rngA = c.address
rngB = "B" & mid(c.address,4)
rngC = "C" & mid(c.address,4)
rngG = "G" & mid(c.address,4)

activecell = Workbook( "Per"). Worksheets("A").range(rngA).value
activecell.offset(0,1) = Workbook(
"Per").workbooks("A").rang(rngB).value
activecell.offset(0,2) = Workbook(
"Per").workbooks("A").rang(rngC).value
activecell.offset(0,3) = Workbook(
"Per").workbooks("A").rang(rngG).value


ActiveCell.Offset(1, 0).Select


Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With
End Sub

I hope this is enough information.

Regard evgny


"Tom Ogilvy" wrote:

Possibly using an autofilter, but it would require knowledge of how your
data is laid out (and where), what you are looking for (values in a
single
column) and what you want to copy.

--
Regards,
Tom Ogilvy

"evgny" wrote in message
...
Hi
I use find, findnext and search in a difrent workbook and when i got
the
addresse I need to get non-contiguos cells values and past/transfer to
the active worksheet, I am usige
rngA = c.address
rngF = "F" & mid(c.address,4)
activecell = workbooks("A").range(rngA).value
activecell.offset(0,1) = workbooks("A").range(rngA).value, but is
there
quiker methode to do this.

regards evgny

Find and tranfere values
 

Thanks, Tom Ogilvy
I will try this on Monday too and let you know
the outcome.

regards evgny



"Tom Ogilvy" wrote:

Sub GetData()
Workbooks("Per.xls").Worksheets("A").Activate
If ActiveCell.Row = 1 Then
MsgBox "Activecell Can't be in Row 1"
Exit Sub
End If
With Workbooks("Per.xls").Worksheets("A")
If Not Intersect(.Range("a1").CurrentRegion, ActiveCell) _
Is Nothing Then
MsgBox "ActiveCell is in the source data - no place" & _
vbNewLine & " to put the results"
Exit Sub
End If
.Range("IV1").Value = .Range("A1").Value
.Range("IV2").Value = 41301
ActiveCell.Offset(-1, 0).Resize(1, 3).Value = _
.Range("A1:C1").Value
ActiveCell.Offset(-1, 3).Value = .Range("G1").Value
.Range("A1").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Range("IV1:IV2"), _
CopyToRange:=ActiveCell.Offset(-1, 0).Resize(1, 4), _
Unique:=False
.Columns(256).Delete
End With

End Sub

--
Regards,
Tom Ogilvy

"evgny" wrote in message
...
Thangs for the answer, Sorry that the my answer i late.
I am looking at collumns A, some time "string" and some time "values"
Look in: Workbook( "Per").worksheets("A").columns."A:A") This workbook is
open, but not active.
columns is like this.
A B C D E F
G
IdNr Ordre Date Text Text Text
Number
41301 610253#1 25.08.04 ...... ...... ...... 2
41301 610253#1 29.08.04 ...... ...... ...... 2
A2501 272834 12.10.04 ...... ...... ......
18
If there is more then one, they are sortet by Date
Sub b()
Range("b2").Select
With Workbook( "Per"). Worksheets("A").Columns("A:A")
Dim c As Variant
Dim firstAddress As Variant

Set c = .Find(41301, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Dim rngA As Variant
Dim rngB As Variant
Dim rngC As Variant
Dim rngG As Variant
rngA = c.address
rngB = "B" & mid(c.address,4)
rngC = "C" & mid(c.address,4)
rngG = "G" & mid(c.address,4)

activecell = Workbook( "Per"). Worksheets("A").range(rngA).value
activecell.offset(0,1) = Workbook(
"Per").workbooks("A").rang(rngB).value
activecell.offset(0,2) = Workbook(
"Per").workbooks("A").rang(rngC).value
activecell.offset(0,3) = Workbook(
"Per").workbooks("A").rang(rngG).value


ActiveCell.Offset(1, 0).Select


Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With
End Sub

I hope this is enough information.

Regard evgny


"Tom Ogilvy" wrote:

Possibly using an autofilter, but it would require knowledge of how your
data is laid out (and where), what you are looking for (values in a
single
column) and what you want to copy.

--
Regards,
Tom Ogilvy

"evgny" wrote in message
...
Hi
I use find, findnext and search in a difrent workbook and when i got
the
addresse I need to get non-contiguos cells values and past/transfer to
the active worksheet, I am usige
rngA = c.address
rngF = "F" & mid(c.address,4)
activecell = workbooks("A").range(rngA).value
activecell.offset(0,1) = workbooks("A").range(rngA).value, but is
there
quiker methode to do this.

regards evgny