XL 2013 VBA - COPIER DERNIERE LIGNE D'UN TABLEAU SUR PLUSIEURS LIGNES

Sheets("BASE").Select
Dim derligne As Long, i as long
derligne = Range("A" & Rows.Count).End(xlUp).Row
for i=derligne to derligne+3000
  Rows(i).Copy Destination:=Rows(i + 1)
next

Sub test()
Sheets("BASE").Select
Dim derligne As Long
derligne = Range("A" & Rows.Count).End(xlUp).Row
dercol = Cells(derligne, Columns.Count).End(xlToLeft).Column
tablo = Range(Cells(derligne, 1).Address & ":" & Cells(derligne, dercol).Address)
ReDim tabres(3000 - derligne, 1 To dercol)
For n = LBound(tabres, 1) To UBound(tabres, 1)
   For m = LBound(tabres, 2) To UBound(tabres, 2)
      tabres(n, m) = tablo(1, m)
   Next
Next
Range("A" & derligne + 1).Resize(UBound(tabres, 1), UBound(tabres, 2)) = tabres
End Sub

Sub Copier()
With Range("A" & Rows.Count).End(xlUp).EntireRow
    If .Row < 3000 Then .Copy .Rows(2).Resize(3000 - .Row)
End With
End Sub