Moving Data Between Worksheets

[WilliamVierra]

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.

[Mel Monroe]

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.Offset(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
>
>

[WilliamVierra]

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

[Mel Monroe]

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
>
>