In For each rng weiterspringen
Gregor
Ich suche nach einer Zellfarbe. Die Zeile dieser Zelle wird dann bis zu 15 Zeilen erweitert und kopiert (eruiert erste und letzte zu kopierende Zeile). Anschliessend muss die Suche dieser Zellfarbe nach der kopierten Zeile weiterfahren, ansonsten werden die gleichen Zeilen mehrmals kopiert. Ich versuchte es mit folgendem Makro, der rng-Bereich wird aber nicht angepasst sondern geht Zelle um Zelle weiter. Wie kann ich das lösen?
Zeile = 6
With Worksheets(Tabellenblatt)
For Each rng In .Range(.Cells(Zeile, Spalte_Überlänge), .Cells(intLastRow, Spalte_Überlänge))
If rng.Interior.ColorIndex = Farbcode Then
Zeile = rng.Row
If IsEmpty(.Cells(Zeile, 1)) And IsEmpty(.Cells(Zeile, 2)) = True Then
Zeile = .Cells(Zeile, 1).End(xlUp).Row
End If
ZeileEnd = IIf(IsEmpty(.Cells(Zeile + 1, 1)), IIf(IsEmpty(.Cells(.Cells(Zeile, 1).End(xlDown).Row - 1, Spalte_Nutzlänge)), .Cells(.Cells(Zeile, 1).End(xlDown).Row, Spalte_Nutzlänge).End(xlUp).Row, .Cells(Zeile, 1).End(xlDown).Row - 1), Zeile)
'--- bestimmt letzte Zeile Tabelle zum Einfügen
intLastRowPaste = Worksheets(Blattname).Cells(Rows.Count, Spalte_Nutzlänge).End(xlUp).Row + 1
'--- Kopierbereich
Set Kopieren = .Range(.Cells(Zeile, 1), .Cells(ZeileEnd, intLastColumn))
'--- Zielbereich
Set Ziel = Worksheets(Blattname).Cells(intLastRowPaste, 1)
Kopieren.Copy Ziel
Zeile = ZeileEnd + 1
End If
Next
End With
Vielen Dank
Gregor