2 Schleifen Anzahl kopieren

Forumthread: 2 Schleifen Anzahl kopieren

27.02.2017 10:53:51

sarah

Hallo liebes Forum,
ich will in einer Liste eine Fläche (Spalte 9) in einer Anzahl x (Spalte 4) kopieren und in ein anderes Tabellenblatt untereinander einfügen. Theoretisch brauche ich doch 2 Schleifen: Die erste für jede Zeile von 42 bis End(xlUp)in Tabelle1 und die zweite Schleife um die Fläche in Anzahl x zu kopieren und in das 2 Tabellenblatt einzufügen:
Beispiel: Spalte 4 = "5" und Spalte 9 = "2qm", d.h. in Tabellenblatt 2 soll 5x 2 qm stehen untereinander.
Dim g, i, lzeile1 As Range
lzeile1 = Sheets("Tabelle1").Cells(Sheets("Tabelle1").Rows.Count, 9).End(xlUp).Row
For Each g In Sheets("Tabelle1").Range(Sheets("Tabelle1").Cells(42, 9), Sheets("Tabelle1").Cells(lzeileMR, 9))
For i = 1 To Sheets("Tabelle1").Cells(Sheets("Tabelle1").Cells(g.Rows, 4)).Value
Sheets("Tabelle1").Cells(Sheets("Tabelle1").Cells(g.Rows, 9)).Copy
Sheets("Tabelle2").Cells(Sheets("Tabelle2").Cells(Rows.Count, "A").End(xlUp).Row + 1, "A").Insert
Next
Next g
Ich danke euch jetzt schon mal herzlich!
Gruß,
Sarah

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: 2 Schleifen Anzahl kopieren

28.02.2017 06:14:29

fcs
AW: 2 Schleifen Anzahl kopieren

28.02.2017 09:45:06

sarah

AW: 2 Schleifen Anzahl kopieren

28.02.2017 06:14:29

fcs

Hallo Sahra,
du hast dich bei der Deklaration der Variablen vertan und die Variable "lZeileMR" vewendet statt "lzeile1".
Ich hab dein Makro mal umgeschrieben und auch eine optimierte/vereinfachte Version erstellt.
LG
Franz

Sub aaTest()
Dim g As Range, i As Long, lzeile1 As Long
lzeile1 = Sheets("Tabelle1").Cells(Sheets("Tabelle1").Rows.Count, 9).End(xlUp).Row
For Each g In Sheets("Tabelle1").Range(Sheets("Tabelle1").Cells(42, 9), Sheets("Tabelle1"). _
Cells(lzeile1, 9))
For i = 1 To Sheets("Tabelle1").Cells(g.Row, 4).Value
Sheets("Tabelle1").Cells(g.Row, 9).Copy
Sheets("Tabelle2").Cells(Sheets("Tabelle2").Cells(Rows.Count, "A").End(xlUp).Row + 1, "A"). _
Insert
Next
Next g
Application.CutCopyMode = False 'Kopiermodus deaktivieren
End Sub
Sub aaTest_optimiert()
Dim g As Range, i As Long, lzeile1 As Long
With Sheets("Tabelle1")
lzeile1 = .Cells(.Rows.Count, 9).End(xlUp).Row
For Each g In .Range(.Cells(42, 9), .Cells(lzeile1, 9))
For i = 1 To .Cells(g.Row, 4).Value
g.Copy
With Sheets("Tabelle2")
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Insert
End With
Next
Next g
End With
Application.CutCopyMode = False 'Kopiermodus deaktivieren
End Sub

AW: 2 Schleifen Anzahl kopieren

28.02.2017 09:45:06

sarah

Super, funktioniert einwandfrei! Vielen, lieben Dank :)

Beliebteste Forumthreads (12 Monate)

Forumthread: 2 Schleifen Anzahl kopieren

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread