Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Zeilen mehrfach woandershin kopieren
#11
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.
Antworten Top
#12
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??
Eine Menge reden, aber nichts sagen können viele...
Antworten Top
#13
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?
Antworten Top
#14
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
Eine Menge reden, aber nichts sagen können viele...
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste