Help!! code to paste

[Sethaholic]

Hi,

I have 2 workbooks.

In the first workbook, it is divided into several worksheets by person's name. Under each person's name, it has a list of account numbers like this:

5-11111
5-22222
5-12345
etc.

In the second workbook, I have account numbers and corresponding personnel next to them. I have coded it so that it will match the account numbers from workbook1 with that of workbook2 and copy the personnel information next to its account. The last step is to paste this information next to the account number in workbook1. Please help me finish this!! Thanks in advance


Sub GetPersonnel()

Dim intRec As Integer, rngData As Range, rngItem As Range, rngAccounts As Range, rngOut As Range
Dim mysht As Worksheet

Application.ScreenUpdating = False

For Each mysht In ThisWorkbook.Worksheets
With mysht
Set rngData = .Range("A70", .Range("A500").End(xlUp)).SpecialCells(xlCellTypeConstants)
End With
With Workbooks("Intermediary - PWC").Worksheets("sheet3")
Set rngAccounts = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

For Each rngItem In rngAccounts
Set rngOut = rngData.Find(What:=rngItem)

If Not rngOut Is Nothing Then
rngOut.Offset(0, 2).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy

'need extra code here!!

Else
End If

Next rngItem
Next mysht
End Sub

[Tim Williams]

Try this

....
If Not rngOut Is Nothing Then

set rngOut= rngOut.offset(0,2)
Range( rngOut, _
rngOut.End(xlDown).End(xlToRight)).Copy _
Destination:=rngItem.Offset(0, 1)


Else

End If
....

You may have to adjust the offsets in the last line - not sure where
you want the data to be pasted.

Tim.



"Sethaholic" <[email protected]>
wrote in message
news:[email protected]...
>
> Hi,
>
> I have 2 workbooks.
>
> In the first workbook, it is divided into several worksheets by
> person's name. Under each person's name, it has a list of account
> numbers like this:
>
> 5-11111
> 5-22222
> 5-12345
> etc.
>
> In the second workbook, I have account numbers and corresponding
> personnel next to them. I have coded it so that it will match the
> account numbers from workbook1 with that of workbook2 and copy the
> personnel information next to its account. The last step is to paste
> this information next to the account number in workbook1. Please
> help
> me finish this!! Thanks in advance
>
>
> Sub GetPersonnel()
>
> Dim intRec As Integer, rngData As Range, rngItem As Range,
> rngAccounts As Range, rngOut As Range
> Dim mysht As Worksheet
>
> Application.ScreenUpdating = False
>
> For Each mysht In ThisWorkbook.Worksheets
> With mysht
> Set rngData = .Range("A70",
> Range("A500").End(xlUp)).SpecialCells(xlCellTypeConstants)
> End With
> With Workbooks("Intermediary - PWC").Worksheets("sheet3")
> Set rngAccounts = .Range("A1:A" &
> Range("A65536").End(xlUp).Row)
> End With
>
> For Each rngItem In rngAccounts
> Set rngOut = rngData.Find(What:=rngItem)
>
> If Not rngOut Is Nothing Then
> rngOut.Offset(0, 2).Select
> Range(Selection, Selection.End(xlDown)).Select
> Range(Selection, Selection.End(xlToRight)).Select
> Selection.Copy
>
> 'need extra code here!!
>
> Else
> End If
>
> Next rngItem
> Next mysht
> End Sub
>
>
> --
> Sethaholic
> ------------------------------------------------------------------------
> Sethaholic's Profile:
> http://www.excelforum.com/member.php...o&userid=25113
> View this thread:
> http://www.excelforum.com/showthread...hreadid=389119
>