Hi Y7654,
Give the following code a try:
Sub RunMe()
Dim lRow, x, nID As Integer
lRow = Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Row
nID = Sheets("Sheet2").Range("A2:A" & Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row).Rows.Count
Sheets("Sheet2").Range("A2:A" & nID + 1).Copy
For x = lRow To 2 Step -1
Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
Next x
For Each cell In Sheets("Sheet3").Range("A2:A" & lRow)
cell.Copy
For x = nID To 1 Step -1
Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
Next x
Next cell
End Sub
Best regards,
Trowa