Hallo Community,
Ich brauche dringend eure Hilfe, weil ich nach stundenlanger Foren Suche immer noch nichts geklappt hat.
- Ich habe eine Exceltabelle mit 12 Sheet
- Jedes dieser 12 Sheets ist gleich aufgebaut
- Wenn in der Spalte D "prüfen" steht, soll diese Zeile auf das 13. Sheet kopiert werden
-Die Liste wird andauernd aktualisiert, sodass sich die Liste im 13. Sheet auch aktualiseren sollte.
Vielen Dank im Voraus ! 
Hallo,
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.
Mfg
Hallo,
erst einmal vielen Dank!
Ich habe jetzt den Code versucht. Bei der Zeile
With Sheets(i).Columns(4)
kommt ein Laufzeitfehler 40036 Anwendungs-oder objektdef. Fehler
Hallo,
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.
1. bis welcher Spalte sind Daten vorhanden?
- bis Spalte K
2. Sind Überschriften vorhanden?
Ja, außer in Spalte A und B , diese sind komplett leer
3. wenn ja, sind die Überschriften in allen identisch?
Ja
4. kommt der gesuchte Wert "prüfen" nur einmal vor oder kann er mehrmals vorkommen?
kommt mehrmals vor
5. Bei Fund, soll der Wert "prüfen" verändert werden oder bleibt an der Fundstelle alles so wie es war?
soll so bleiben
Hallo,
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:
Am Anfang:
Flag = false
In der if -Passage:
Flag = true
Und am Ende:
If flag then excelgirl
Mfg
Hallo,
wie heißen denn die Überschriften?
Hallo,
folgendes ist gegeben.
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.
@ Attilla
Bei
Range("C1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"AA1:AA2"), CopyToRange:=Range("AB1:AK1"), Unique:=False
kommt ein Fehler
@Fennek
Was ist mit einer Schleife gemeint?
@BoskoBiati von der Tabelle oder von den Sheets?