Hallo Forumsgemeinde,

per Button kopiere ich Zeilen, welche in einer Spalte ein bestimmtes Kriterium enthalten, aus mehren Tabellenblättern in ein separates Tabellenblatt.

Das funktioniert auch perfekt, allerdings wird immer ein Text gesucht (Im Beispiel alle Zeilen,welche "ja" in Spalte13 enthalten)

Nun würde ich das gern erweitern und alle Zeilen, welche ein bestimmtes Jahr enthalten kopieren lassen. In den Spalten stehen Daten xx.yy.zzzz.

Davon wird nur das Jahr benötigt.

Ich habe schon versucht per Button ein Formular aufzurufen, in dem ich ein bestimmtes Jahr eintrage um anschliessend den Kopierprozess aus dem Formular heraus zu starten, aber da bin ich wohl zu doof dazu!

Könnt ihr mir da weiterhelfen?

Danke schonmal im Voraus!

Sub EintraegeKopieren()
   
Dim ws As Worksheet
Dim wsTarget As Worksheet
Dim rngSource As Range
Dim i As Integer, j As Integer
Dim lr As Long, lrTarget As Long, col As Long
Set wsTarget = Sheets("Gesamtliste")
   
For i = 3 To 53
  
Set ws = Sheets(i)
   
'Letzte Zeile im Sheet(Gesamtliste) ermitteln
lrTarget = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row
    With ws
        'Letzte Zeile im jeweiligen Sheet ermitteln
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        'Prüfen, ob ab Zeile 20 Werte im jeweiligen Sheet stehen
        If lr >= 20 Then
            'Durchlauf aller Zeilen ab Zeile 20 bis zur letzten verwendeten Zeile
            For j = 20 To lr
                'aktuelle Zeile kopieren
                    Set rngSource = .Range(.Cells(j, 1), .Cells(j, 18))
                        'Alle Zeilen,welche "ja" enthalten kopieren und in Sheet("Gesamtliste") einfügen
                        If rngSource.Cells(1, 13).Value = "ja" Then
                           rngSource.Copy Destination:=wsTarget.Cells(lrTarget + 1, 1)
                           lrTarget = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row
                        End If
            Next j
        End If
    End With
Next i
End Sub