Make copy macro faster

[moosmahna]

Hy,
I have a worksheet with a lot(!!!) of data in cells A to G. I have to copy them one after another to another workseet in the same workbook but copy them for 8 times. I already have a macro but it gets always slower and slower when copying hundreds of rows.
Here is my macro:

Sub kopieren()'Copy range

Dim rng1 As Range
Set rng1 = Sheets("1").Range("A1:G1")

rng1.Copy
  Sheets("2").Cells(Rows.Count, "A").End(xlUp).Offset(1). _
    PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False

End Sub

Sub multiple()

Dim i As Long
For i = 1 To 8
Call kopieren
Next

End Sub

Sub ErsteReiheLoeschen() 'Delete first row when copy done
Dim ws1 As Worksheet
Set ws1 = Worksheets("1")

ws1.Select
  Rows(1).EntireRow.Delete
End Sub

Sub Einzeln()
Call multiple
Call ErsteReiheLoeschen

End Sub

Sub Start()'Start all macros

Dim z As Long
For z = 1 To 2000
Call Einzeln
Next

End Sub

Can you help me please
Thanks a lot Roman