Dobry den tohle Vám pomůže.

'cyklus se ukončí jak najde prázdnou buňku
Do Until Selection = ""
Select Case Selection
End Select
'
Dim FrstR As Long, FrstCll As Range
With ActiveSheet
FrstR = .Range(.Range("A1"), .Range("A1").End(xlDown)).Rows.Count
Set FrstCll = .Range("A1").Offset(FrstR, 0)
End With
' MsgBox FrstCll.Address
FrstCll.Select
ActiveSheet.Paste

Loop