Help!! code to paste

[Sethaholic]

Hi,

I have 2 workbooks.

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

5-11111
5-22222
5-12345
etc.

In the second workbook, I have account numbers and correspondin
personnel next to them. I have coded it so that it will match th
account numbers from workbook1 with that of workbook2 and copy th
personnel information next to its account. The last step is to past
this information next to the account number in workbook1. Please hel
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 Su

 

[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]...