Sub test()
Dim rws As Long, rw As Long, i As Long
Dim cel As Range
rws = Sheet1.UsedRange.Rows.Count
For i = 1 To rws
If Cells(i, 1) <> "" And Val(Cells(i, 1)) > 0 Then
Set cel = Cells(i, 1)
Sheet1.Range(cel, cel.Offset(0, 1).End(xlDown)).Copy Destination:=Sheet2.Range("B65536").End(xlUp).Offset(2, -1)
End If
Next
End Sub