Schleife in Schleife

Hallo VBA-Experten
wer kann nachfolge 2 Programmschritte in eine große Schleife zusammenführen?
Programmschritte:
1.Schritt:
-- Schleife soll beginnend bei Zeile 31 einhundert mal ausgeführt werden
-- Dim iRow%
-- For iRow = 31 To Cells(Rows.Count, 1).End(xlUp).Row
-- If Cells(iRow, 14) "" And Cells(iRow, 14).Interior.ColorIndex = 40 Then
-- Range("K16:X16").Copy Cells(iRow, "K")
-- End If
2.Schritt
-- Range("K16:x4000").Copy
-- Range("K16").PasteSpecial Paste:=xlPasteValues
die Schleife soll abwechselnd Schritt 1 und 2 ausführen:
Schleife aus 1. für Zeile 131:230 (=100 mal ausführen)
dann führe Schritt 2. aus
dann Schleife aus Schritt 1. für 231:330 (=100 mal ausführen)
dann führe Schritt 2. aus
...... usw (bis Tabellenende.
Danke Floh

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub KopierDat() Dim iRow%, j% For iRow = 31 To Cells(Rows.Count, 1).End(xlUp).Row For j = iRow To iRow + 99 If Cells(iRow, 14) <> "" And Cells(iRow, 14).Interior.ColorIndex = 40 Then Range("K16:X16").Copy Cells(iRow, "K") End If Next j Range("K16:x4000").Copy Range("K16").PasteSpecial Paste:=xlPasteValues iRow = j - 1 Next iRow End Sub

Sub KopierDat02() 1. Dim iRow%, j% 2. For iRow = 31 To Cells(Rows.Count, 1).End(xlUp).Row 3. For j = iRow To iRow + 99 4. If Cells(iRow, 4) <> "" And Cells(iRow, 4).Interior.ColorIndex = 40 Then 5. Range("K16:X16").Copy Cells(iRow, "K") 6. End If 7. Next j 8. Range("K31:x4000").Copy 9. Range("K31").PasteSpecial Paste:=xlPasteValues 10. iRow = j - 1 11. Next iRow 12. End Sub

Hallo Ramses
Konnte den Fehler leider immer noch nicht beheben.
Wenn ich Zeile 3, 7, 8, 9, 10 des nachfolgenden Programms deaktiviere läuft die Schleife.
Die zu zählenden Zeilen habe ich auf Spalte D abgändert.
Kann es sein das der Fehler mit copy oder pastespezial zusammenhängt ?
Gibt es eine Alternative mit value?
Gruß Floh


Sub KopierDat02()
1. Dim iRow%, j%
2. For iRow = 31 To Cells(Rows.Count, 4).End(xlUp).Row
3.   For j = iRow To iRow + 99
4.      If Cells(iRow, 4) <> "" And Cells(iRow, 4).Interior.ColorIndex = 40 Then
5.         Range("K16:X16").Copy Cells(iRow, "K")
6.      End If
7.   Next j
8.   Range("K31:x4000").Copy
9.   Range("K31").PasteSpecial Paste:=xlPasteValues
10.   iRow = j - 1
11. Next iRow
12. End Sub

Sub Makro02() Dim iRow%, j% For iRow = 31 To Cells(Rows.Count, 4).End(xlUp).Row For j = iRow To iRow + 99 If Cells(j, 4) <> "" And Cells(j, 4).Interior.ColorIndex = 40 Then Range("K16:X16").Copy Destination:=Range("K" & j) End If Next j Range("K" & iRow & ":X" & j).Copy Range("K" & iRow).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False iRow = j - 1 Next iRow End Sub

Beliebteste Forumthreads (12 Monate)

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread