Wenn man davon ausgeht, dass der Index der Monate 1-12 ist und das Ergebnis-sheet "Result" heist, könnte folgender Code helfen:
Sub excelgirl()
Dim ws as sheets
Dim rng as range
NSh = thisworkbook.sheets.count -1
MySuch = "Prüfen"
For i = 1 to nSh
With sheets(i).columns(4)
Set rng = .find(mySuch)
If not rng is nothing then
Zeile = rng.row
.cells(zeile) = "ok"
.rows(zeile).entirerow.copy
Lr = sheets("Result").range("a1").currentregion.rows.count +1
Sheets("Result").cells(lr,1).pastespecial
Application.cutcopymode = false
End if
Set rng = nothing
End with
Next
End sub
Das Makro ändert jeweils "Prüfen" in "ok", damit Zeilen nur einmal kopiert werden. Entweder muss der Makro regelmäßig von Hand gestartet werden, oder mit "application.onTime" in eine selbstaufrufende Schleife gelegt werden.
1. bis welcher Spalte sind Daten vorhanden?
2. Sind Überschriften vorhanden?
3. wenn ja, sind die Überschriften in allen identisch?
4. kommt der gesuchte Wert "prüfen" nur einmal vor oder kann er mehrmals vorkommen?
5. Bei Fund, soll der Wert "prüfen" verändert werden oder bleibt an der Fundstelle alles so wie es war?
Das Aktualisieren würde ich beim betreten der Ergebnistabelle automatisch über das WorksheetActivate Ereignis anstoßen.
Der Code unterstellt, dass der Sheet-Index von 1-12 existiert, falls nicht muss die for...next schleife in eine for'each.Schleife'umgesetz'werden. Eine Markierung der bereits kopierten Zeilen ist notwendig, damit Zeilen nicht doppelt kopiert werden, wie das umgesetz wird, ist beliebig.
Der Code'kopiert jedesmal nur den ersten Treffer, muss also mehrfach laufen. Dies kann auch im Programm erledigt werden:
Die Tabelle, in die kopiert werden soll, heißt "Übersicht"
Dann folgenden Code hinter die Tabelle "Übersicht"
Code:
Private Sub Worksheet_Activate()
Call aktualisieren
End Sub
und weiter folgenden Code in ein allgemeines Modul
Code:
Option Explicit
Sub aktualisieren()
Dim i As Long
Dim lngA As Long, lngZ As Long
Dim strSuch As String
Sheets("Übersicht").Select 'falls mal versehentlich aus einer anderen Tabelle heraus aufgerufen wurde
strSuch = "prüfen" 'gesuchter Wert
Range("C1").CurrentRegion.Offset(1, 0).ClearContents
Range("AA1").CurrentRegion.Clear
lngZ = 2
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
If Sheets(i).Name <> ActiveSheet.Name Then
With Sheets(i)
lngA = Application.CountIf(Sheets(i).Columns("D"), strSuch)
If lngA > 0 Then
Range("AA1") = Range("d1")
Range("AA2") = strSuch
.Range("C1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"AA1:AA2"), CopyToRange:=Range("AB1:AK1"), Unique:=False
Range("AB2:AK" & lngA + 1).Copy Range("C" & lngZ)
lngZ = lngZ + lngA
End If
End With
End If
Next i
Range("AA1").CurrentRegion.Clear
Application.ScreenUpdating = True
End Sub
Du kannst den Code manuell starten oder aber er wird automatisch bei Aktivierung der Tabelle "Übersicht" gestartet.