Rote Zeilen der Tabblätter in Gesamt Tab kopieren
01.01.2017 20:05:02
Mooslechner
liebe Helfer dieses Forums:
Ich möchte aus allen Tabblättern dieses Workbooks die roten Zeilen in das Gesamt Tab kopieren (untereinander).
Das Makro läuft, wenn ich lngZeile auf 1 setze.
Fehler 1 kann IngZeile nicht selbsständig ermitteln lassen.
Fehler 2: kann hier nicht variabel sein:
For Each rngzelle In ActiveSheet.Range("A1:A6580")
Fehler 3: läuft nicht durch alle Tabblätter
Vielen Dank für die Hilfe
nach langer Recherche bin ich zumindestens soweit gekommen:
Sub Rote_Zeilen_Kopieren()
Dim rngzelle As Range
Dim lngZeile As Integer
Dim lz As Integer
Dim ws As Worksheet
' Sheets Gesamt: Ermittlung der letzten Zeile in Spalte B
Worksheets("Gesamt").Select
IngZeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
Debug.Print IngZeile
'hier auf 1 setzen, sonst Fehler
lngZeile = 1
' Sheet1: Ermittlung der letzten Zeile in Spalte B
Sheets("Sheet1").Select
lz = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Debug.Print lz
' Alle Tabellenblätter durchlaufen
For Each ws In ThisWorkbook.Worksheets
'Rote Zeilen in dieses kopieren
With Worksheets("Gesamt")
For Each rngzelle In ActiveSheet.Range("A1:A6580")
If rngzelle.Interior.ColorIndex = 3 Then
rngzelle.EntireRow.Copy .Cells(lngZeile, 1)
'Anwendungs oder Objektorientierter Fehler
lngZeile = lngZeile + 1
End If
Next rngzelle
End With
Next ws
End Sub