For two lists use the slightly modified code below, highlight your lists and then give them a name "MyRange", look Herefor a "how to" on named ranges[vba]Sub copy_n_paste()
Dim Rng As Range
Dim TgtValue As Range
Application.ScreenUpdating = False
Set Rng = Sheets("Sheet1").Range("MyRange")
Set TgtValue = Sheets("Sheet1").Range("C2")
For Each MyCell In Rng
MyCell.Copy Destination:=Sheets("Sheet1").Range("B2")
TgtValue.Copy
With Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0)
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End With
Next MyCell
Application.ScreenUpdating = True
End Sub[/vba]