Hallo Werner,

der Beispielscode sollte nur darstellen wie das ganze aufgebaut ist! Du hast Recht, im Beispiel wurde nach "ja" in Spalte 13 gesucht.

Die 18 bei " Set rngSource = .Range(.Cells(j, 1), .Cells(j, 18))" bezieht sich ja auf den Bereich bis zu welcher Spalte die Zeilen kopiert werden sollen.

Bei " If rngSource.Cells(1, 7).Value = Var1 Then" prüfe ich Spalte 7 nach dem Inhalt der Variable "Var1" welche ihren Inhalt aus dem Textfeld der UserForm bezieht.

Das funktioniert auch super, wenn ich das komplette Datum in das Textfeld der UserForm eingebe. (Bsp. bei der Eingabe 01.02.2000 werden alle Zeilen die in Spalte 7 das Datum enthalten kopiert)

Mein Ansinnen ist das ich im Textfeld nur das Jahr (Bsp. 2000) eingebe und mir alle Einträge aus dem Jahr 2000 kopiert werden.Soll heißen ich müsste nur das Jahr in den Spalten überprüfen und dabei komme ich nicht weiter.

.

Hier nun mein aktueller Code:

Public Sub EintraegeKopieren_Jahre()
   
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))
                        'Einträge kopieren und am Ende in Sheet("Gesamtliste") einfügen
                        If rngSource.Cells(1, 7).Value = Var1 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