I have a spreadsheet with many worksheets in it.

One worksheet contains all the data for the other worksheets. What I
need to automate is moving the data specific to an individual worksheet
from the data worksheet to the specific worksheet.

The key for the data is an account number that is in column L of the
data work sheet. The data preceding it in the row is what I need to
move.

I have been using OFFSET with Match with no real success. The columns
in all the worksheets are identical. The target worksheets contain the
account number in cell a3.

Typically there are 1,500 to 2,000 rows of data in the data worksheet.

So I need to search down column L in the data worksheet until I find
the matching account and copy the data in columns A through L into the
same columns in the target worksheet.

The search then needs to be preformed again for the next row until all
the rows for that account are received.


--
WilliamVierra
------------------------------------------------------------------------
WilliamVierra's Profile: http://www.excelforum.com/member.php...o&userid=26107
View this thread: http://www.excelforum.com/showthread...hreadid=395492

I think a good way for you to do this would be to use the find function to
return a range, and then offset that range accordingly. My first action
would be to use the account numbers in the other sheet as your reference
point. Here is some code, assuming that your account number is a3 for all of
your worksheets. I am also assuming that your lookup numbers are in column A
on your various worksheets, and the data you are importing from the data
sheet from columns are A through M (not N, since that is the account number)
will be but in B through L since you do not want to overwrite your account
numbers.

Sub DataMover()

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim wks As Worksheet
Dim LookupRange As Range

Worksheets("Data Worksheet").Activate

For Each wks In Worksheets

' Skip the data worksheet
If wks.Name < "Data Worksheet" Then
' Gather the lookup numbers
Set LookupRange = wks.Range("A3")

' Start cycling through the account numbers on the worksheets
For i = 0 To Range(LookupRange, LookupRange.End(xlDown)).Cells.Count
- 1
' For the columns B through M (11 columns)
k = 1
For j = -11 To -1 Step 1
LookupRange.Offset(i, k).Value = Range("L1",
Range("L1").End(xlDown)).Find(What:=LookupRange.Of fset(i, 0).Value).Offset(0,
j).Value
k = k + 1
Next j
Next i
End If
Next wks

End Sub

Hope this helps.


Mel


"WilliamVierra" wrote:


I have a spreadsheet with many worksheets in it.

One worksheet contains all the data for the other worksheets. What I
need to automate is moving the data specific to an individual worksheet
from the data worksheet to the specific worksheet.

The key for the data is an account number that is in column L of the
data work sheet. The data preceding it in the row is what I need to
move.

I have been using OFFSET with Match with no real success. The columns
in all the worksheets are identical. The target worksheets contain the
account number in cell a3.

Typically there are 1,500 to 2,000 rows of data in the data worksheet.

So I need to search down column L in the data worksheet until I find
the matching account and copy the data in columns A through L into the
same columns in the target worksheet.

The search then needs to be preformed again for the next row until all
the rows for that account are received.


--
WilliamVierra
------------------------------------------------------------------------
WilliamVierra's Profile: http://www.excelforum.com/member.php...o&userid=26107
View this thread: http://www.excelforum.com/showthread...hreadid=395492

Thanks Mel this got me started on the write path.

I did it a slightly different way as follows:

'Find & Union.
Sub alkek_get_rows()
Dim R As Range, FindAddress As String
Dim MatchRows As Range



'select the workstheet wksht
Sheets("wksht").Select

'Set the range in which we want to search in
With Sheet42.Range("A5:N2500")

'Search for the first occurrence of the item
Set R = .Find("140633MB")

'If a match is found.
If Not R Is Nothing Then
'Store the address of the cell where the first match is found in
variable.
FindAddress = R.Address
'Add the first cell found to our "MatchRows" range.
Set MatchRows = R
'Start to loop.
Do
'Search the next cell with a matching value.
Set R = .FindNext(R)
'And add that cell to our "MatchRows" range.
Set MatchRows = Application.Union(MatchRows, R)
'Loop as long matches are found, and the address of the cel
where a match is found,
'is < as the address of the cell where the first match is foun
(FindAddress).
Loop While Not R Is Nothing And R.Address < FindAddress
End If
End With

'If the "MatchRows" range exist (if at least one match is found),
'select the entire row(s) and color them.
If Not MatchRows Is Nothing Then
MatchRows.EntireRow.Select
Selection.Copy
Sheets("alkek").Select
Range("A6").Select
ActiveSheet.Paste

End If

'Clear memory.
Set R = Nothing
Set MatchRows = Nothing

End Su

--
WilliamVierr
-----------------------------------------------------------------------
WilliamVierra's Profile: http://www.excelforum.com/member.php...fo&userid=2610
View this thread: http://www.excelforum.com/showthread.php?threadid=39549

That works too. However, I would avoid using .select in any code, as it
slows things down considerably and is really not needed. If you need to
change worksheets, use .Activate, and for pasting into ranges, you don't need
to select the range first. Just paste to it. It saves an extra step and can
speed things up with a long procedure considerably.

Mel


"WilliamVierra" wrote:


Thanks Mel this got me started on the write path.

I did it a slightly different way as follows:

'Find & Union.
Sub alkek_get_rows()
Dim R As Range, FindAddress As String
Dim MatchRows As Range



'select the workstheet wksht
Sheets("wksht").Select

'Set the range in which we want to search in
With Sheet42.Range("A5:N2500")

'Search for the first occurrence of the item
Set R = .Find("140633MB")

'If a match is found.
If Not R Is Nothing Then
'Store the address of the cell where the first match is found in a
variable.
FindAddress = R.Address
'Add the first cell found to our "MatchRows" range.
Set MatchRows = R
'Start to loop.
Do
'Search the next cell with a matching value.
Set R = .FindNext(R)
'And add that cell to our "MatchRows" range.
Set MatchRows = Application.Union(MatchRows, R)
'Loop as long matches are found, and the address of the cell
where a match is found,
'is < as the address of the cell where the first match is found
(FindAddress).
Loop While Not R Is Nothing And R.Address < FindAddress
End If
End With

'If the "MatchRows" range exist (if at least one match is found),
'select the entire row(s) and color them.
If Not MatchRows Is Nothing Then
MatchRows.EntireRow.Select
Selection.Copy
Sheets("alkek").Select
Range("A6").Select
ActiveSheet.Paste

End If

'Clear memory.
Set R = Nothing
Set MatchRows = Nothing

End Sub


--
WilliamVierra
------------------------------------------------------------------------
WilliamVierra's Profile: http://www.excelforum.com/member.php...o&userid=26107
View this thread: http://www.excelforum.com/showthread...hreadid=395492