ich hab eine Arbeitsmappe mit 5 Tabellen, möchte nun in Tabelle 1 einen Button setzten welcher alle Tabellen
nach rot Ausgefüllten Zellen durchsucht und diese dann in Tabelle 5 kopiert. Der inhalt der roten zellen in Tabelle 1-4 sollen nach dem kopieren gelöscht werden.
Button und so alles keine Problem aber nen code zum suchen in allen Tabellen und dann kopiert klappt irgendwie nicht.
Könnt Ihr mit bitte ein paar tips oder vorschläge geben wie ich das angehen soll?
hier ein sehr rudimentärer Code, den ich auch nicht unbedingt empfehle. Was ist denn das Kriterium, weshalb die Zellen rot werden? Kann man die Suchbereiche eingrenzen?
Code:
Option Explicit
Sub redCells()
Dim wks As Worksheet
Dim rng As Range
Dim redRange As Range
For Each wks In ThisWorkbook.Worksheets
If wks.CodeName <> "SheetVonDemDuStartest" Then
For Each rng In wks.UsedRange
If rng.Interior.Color = vbRed Then
SheetVonDemDuStartest.Cells(UsedRange.Rows.Count + 1, 1).Value = rng.Value
If redRange Is Nothing Then
Set redRange = rng
Else
Set redRange = Union(redRange, rng)
End If
End If
Next rng
redRange.Delete
Set redRange = Nothing
End If
Next wks
End Sub
es ist eine Art Lagerverwaltung.
Auf allen Tabellenblätter stehen in A5 bis E5 verscheidene Daten, wenn ein Mitarbeiter in Spalte F ein Datum eingibt wird die Zeile von A bis F rot
Am Monatsende möchte ich alle roten zeilen in ein extra Tabellenblatt kopieren und diese dann von den anderen Tabellen löschen.
also mein Code oben ist getestet und funktioniert. Wenn Du Interesse an einer Optimierung hast, lade mal bitte eine Beispieldatei mit dem selben Aufbau wie dein Original hoch.
Private Sub CommandButton1_Click()
Dim wks As Worksheet
Dim i As Long
For Each wks In ThisWorkbook.Worksheets
If wks.CodeName <> "Tabelle1" And wks.CodeName <> "Tabelle5" Then
For i = 7 To 5 Step -1
With wks
If .Cells(i, 4).Value > 0 Then
Tabelle5.Cells(Tabelle5.UsedRange.Rows.Count + 1, 1).Resize(1, 4) = .Cells(i, 1).Resize(1, 4).Value
.Rows(i).Delete
End If
End With
Next i
End If
Next wks
End Sub
