Makro do kopiowania zakresów miedzy arkuszami VB-Excel

'To makro kopiuje zakres do drugiego arkusza
'w nim sprawdza we wskazanej kolumnie pierwsza pustą

Sub kopiowanie()
Dim kom As Range
Application.ScreenUpdating = False
Range("A8:D18").Copy
Sheets("Arkusz2").Select
For Each kom In Range("A1:A65536")
If IsEmpty(kom.Value) Then
Cells(kom.Row, kom.Column).Select
Exit For
End If
Next
ActiveSheet.Paste
Range("A1").Select
Sheets("Arkusz1").Select
Application.CutCopyMode = False
Range("A1").Select
Application.ScreenUpdating = True
End Sub

'To makro kopiuje zakres do drugiego arkusza
'w nim sprawdza we wszystkich kolumnach
'czy nie ma danych w którejś i wstawia w pierwszy
'wiersz który jest całowicie pusty


Sub kopiowanie()
Dim LastRow As Long

Range("A8:D18").Select
Selection.Copy
Sheets("Arkusz2").Select
       

If WorksheetFunction.CountA(Cells) > 0 Then
LastRow = Cells.Find(What:="*", _
After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Ostatni_wiersz = LastRow
Else
Ostatni_wiersz = 0
End If


ActiveSheet.Cells(Ostatni_wiersz + 1, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Arkusz1").Select
  
End Sub






'Wersja z pozostawieniem jednego wiersza pustego po ostatnim



Sub kopiowanie()

Dim kom As Range
Application.ScreenUpdating = False
Range("A8:D18").Copy
Sheets("Arkusz2").Select
For Each kom In Range("A1:A65536")
If IsEmpty(Range("A1")) Then Range("A1").Select: Exit For
If IsEmpty(kom.Value) And IsEmpty(Cells(kom.Row + 1, 1)) Then
Cells(kom.Row + 1, kom.Column).Select
Exit For
End If
Next
ActiveSheet.Paste
Range("A1").Select
Sheets("Arkusz1").Select
Application.CutCopyMode = False
Range("A1").Select
Application.ScreenUpdating = True

End Sub



'To należy zmienić aby w tym drugim przykładzie wklejać
'do kolumny o jeden dalej od ostatniej

ActiveSheet.Cells(Ostatni_wiersz + 1, 1).Select 
'czyli do ostatniego wiersza w którym coś jest dodajemy 1

ActiveSheet.Cells(Ostatni_wiersz + 2, 1).Select 
'czyli do ostatniego wiersza w którym coś jest dodajemy 2