A little loop would help

Sub FindValue()


Dim r As Range, c As Range, s As Range
Dim ws As Worksheet, ws1 As Worksheet

Set ws = Worksheets("Sheet1")
Set ws1 = Worksheets("Sheet2")
Set r = ws.Range("A1", ws.Range("A65536").End(xlUp))
Set s = ws1.Range("A2")

For Each c In r.Cells
If c = s Then c.Offset(0, 1).Copy _
Destination:=ws1.Range("D65536").End(xlUp).Offset( 1, 0)
Next c

End Sub