Help! How do I shift rows down?

[Sethaholic]

Hi,

I have a relatively simple task to ask. First, here is my code:


Sub GetPWCPersonnel()

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("A71"
.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 rngData
Set rngOut = rngAccounts.Find(What:=rngItem)

If rngOut Is Nothing Then
rngItem.Offset(0, 2).Value = "N/A"

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

'need code here!!

End If

Next rngItem
Next mysht
End Sub

How do I code it so that when it copies the information into th
destination cell, it will shift all the rows down? Please help! Thank
in advance

 

[McManCSU]

Record a simple macro and it will show you how. Then copy i