Zeilen mehrfach woandershin kopieren

[PeterN]

Hi Frogger!

Vielen Dank für die schnelle Antwort!

Jetzt geht es natürlich weil er nur die 12 Zeilen (wie aus der Beispieldatei) bearbeitet. Aber meine Liste hat im Original  7829 Zeilen.

[Frogger1986]

so müsste das Makro nun auch mit der Großen liste klar kommen! Allerdings erschließt sich mir der Nutzen der Sache nicht ganz... wenn ich so pi mal Daumen den Durchschnitt der gewollten Anzahl der Kopien sehe, müssten das ja um die 400000 Zeilen sein, dann in deiner Tabelle zum Schluss.. Was machst du damit??

[PeterN]

Die 7829 Zeilen ergeben 80.072 Zeilen netto. Nach unten werden die Werte in Spalte D ja immer kleiner. Ab Zeile 3000 z.B. 10 und kleiner.

Also mit Deinem Tool hört das Teil immer ab Zeile 12 auf. Was muss ich denn in dem Code ändern, das es statt 12 alle 7829 Zeilen bearbeitet?

[Frogger1986]

versuche es mal so 

Code:

Option Explicit

Sub vermeheren()
Dim Last As Long
Dim i As Long
Dim c As Long
Dim count As Long

Last = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row

Range("A7831:D" & Last).Clear

For i = 1 To 7829
           

           For c = 1 To CInt(Cells(i, 4).Value)
                   
                   Last = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row + 1
                   
                   If Last = 7830 Then Last = 7831 Else Last = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row + 1
                   
                   Range(Cells(i, 1), Cells(i, 4)).Copy Range(Cells(Last, 1), Cells(Last, 4))
           
                   
           Next


Next

MsgBox "Fertig!"

End Sub