Sub test()
Dim A()
Dim i As Long
Dim x As Long
With Sheets("Sheet1")
For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If Val(Right(.Cells(i, "A").Value, 1)) Mod 2 = 0 Then
ReDim Preserve A(x)
A(x) = .Cells(i, "A").Value
x = x + 1
End If
Next
End With
With Sheets("Sheet2")
.Range("A1").Resize(UBound(A()) + 1).Value = Application.Transpose(A())
End With
End Sub