Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Rote Zeilen der Tabblätter in Gesamt Tab kopieren

Rote Zeilen der Tabblätter in Gesamt Tab kopieren
01.01.2017 20:05:02
Mooslechner
Hallo,
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

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Rote Zeilen der Tabblätter in Gesamt Tab kopieren
01.01.2017 22:21:24
Werner
Hallo,
Versuch mal so:
Sub Rote_Zeilen_Kopieren()
Dim rngBereich      AS Range
Dim rngZelle        As Range
Dim loLetzteQ       As Long
Dim loLetzteZ       As Long
Dim ws              As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name  "Gesamt" Then
loLetzteZ = Worksheets("Gesamt").Cells(Rows.Count, 2).End(xlUp).Row + 1
With ws
loLetzteQ = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rngBereich = .Range(.Cells(1, 1), .Cells(loLetzteQ, 1))
For Each rngZelle In rngBereich
If rngZelle.Interior.ColorIndex = 3 Then
rngZelle.EntireRow.Copy Worksheets("Gesamt").Rows(loLetzteZ)
loLetzteZ = loLetzteZ + 1
End If
Next rngZelle
End With
End If
Next ws
End Sub
Ist aber ungetestet, hab grad keinen Rechner zur Hand und habe auf dem Tablet geschrieben.
Gruß Werner
Anzeige
AW: Rote Zeilen der Tabblätter in Gesamt Tab kopieren
01.01.2017 22:44:02
Werner
Hallo,
Ich hab noch was vergessen:
Sub Rote_Zeilen_Kopieren()
Dim rngBereich      AS Range
Dim rngZelle        As Range
Dim loLetzteQ       As Long
Dim loLetzteZ       As Long
Dim ws              As Worksheet
Applications.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
If ws.Name  "Gesamt" Then
loLetzteZ = Worksheets("Gesamt").Cells(Rows.Count, 2).End(xlUp).Row + 1
With ws
loLetzteQ = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rngBereich = .Range(.Cells(1, 1), .Cells(loLetzteQ, 1))
For Each rngZelle In rngBereich
If rngZelle.Interior.ColorIndex = 3 Then
rngZelle.EntireRow.Copy Worksheets("Gesamt").Rows(loLetzteZ)
loLetzteZ = loLetzteZ + 1
End If
Next rngZelle
End With
End If
Next ws
Applications.ScreenUpdating = True
End Sub
Im Übrigen ist die Frage, ob es Sinn macht mit einer Schleife die kompletten Spalten A zeilenweise abzuklappern und die zutreffenden Zeilen einzeln zu kopieren. Kommt darauf an wieviele Zeilen durchlaufen und wieviele Zeilen dann kopiert werden müssen.
Excel kann auch nach Farben filtern. Das hätte den Vorteil, dass du alle roten Zeilen als einen Block hast und dann auch nur einmal zu kopieren brauchst. Das ist u.U. wesentlich schneller. Kannst es ja mal versuchen und es mit dem Makrorekorder aufzeichnen.
Gruß Werner
Anzeige
AW: Rote Zeilen der Tabblätter in Gesamt Tab kopieren
02.01.2017 11:14:37
Werner
Hallo,
was mir gerade noch aufgefallen ist:
Die Autokorrektur meines Tablets hat das
Applications.ScreenUpdating = False
Applications.ScreenUpdating = True
ein S angahängt was natürlich nicht richtig ist. Richtig so:
Application.ScreenUpdating = False
Application.ScreenUpdating = True
Gruß Werner
AW: Rote Zeilen der Tabblätter in Gesamt Tab kopieren
02.01.2017 21:39:04
Mooslechner
Hallo Werner,
Potzblitz, das war schnell, und funzt.
Funktioniert einwandfrei, vielen Dank.
Das mit Makrorekorder nehme ich auf und füge es ein, wird probiert.
Wünsche tolles 2017.
vg M.
Anzeige
AW: Gerne u. Danke für die Rückmeldung. o.w.T.
02.01.2017 23:14:48
Werner

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige