Hallo,

teste mal:

Option Explicit

Public Sub EintraegeKopieren_Jahre()
    
Dim ws As Worksheet
Dim wsTarget As Worksheet
Dim i As Long, j As Long, lr As Long, lrTarget As Long
Dim Var1 As String

Set wsTarget = Sheets("Gesamtliste")

Erneut:
'weiter bei Fehler
On Error Resume Next
'Inputbox für Eingabe des Jahres
Var1 = InputBox("Bitte ein Jahr eingeben, Format: JJJJ", "Jahr auswählen")
'Prüfen ob eine Eingabe erfolgt ist
If Var1 = vbNullString Then Exit Sub
'Prüfen ob eine 4-stellige Zahl eingegeben wurde
If Not IsNumeric(CLng(Var1)) Or Len(Var1) <> 4 Then
    MsgBox "Nur 4-stellige Zahlenwerte zuässig."
    'Fehler zurücksetzen
    On Error GoTo 0
    'bei Fehleingabe zurück zur Inputbox
    GoTo Erneut
    Exit Sub
Else
    'Schleife über die Blätter
    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
                            'Prüfen ob Jahr aus Inputbox mit Jahr aus Zelle übereinstimmg
                            If Year(.Cells(j, 7)) = CLng(Var1) Then
                                'wenn ja dann Daten kopieren
                                .Range(.Cells(j, 1), .Cells(j, 18)).Copy wsTarget.Cells(lrTarget + 1, 1)
                                'Zähler für Zielzeile hochsetzen
                                lrTarget = lrTarget + 1
                            End If
                        Next j
                    End If
            End With
    Next i
End If

'Rangevariable leeren
Set wsTarget = Nothing
Set ws = Nothing
'Fehler zurücksetzen
On Error GoTo 0
End Sub

Gruß Werner