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:
On Error Resume Next
Var1 = InputBox("Bitte ein Jahr eingeben, Format: JJJJ", "Jahr auswählen")
If Var1 = vbNullString Then Exit Sub
If Not IsNumeric(CLng(Var1)) Or Len(Var1) <> 4 Then
MsgBox "Nur 4-stellige Zahlenwerte zuässig."
On Error GoTo 0
GoTo Erneut
Exit Sub
Else
For i = 3 To 53
Set ws = Sheets(i)
lrTarget = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row
With ws
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
If lr >= 20 Then
For j = 20 To lr
If Year(.Cells(j, 7)) = CLng(Var1) Then
.Range(.Cells(j, 1), .Cells(j, 18)).Copy wsTarget.Cells(lrTarget + 1, 1)
lrTarget = lrTarget + 1
End If
Next j
End If
End With
Next i
End If
Set wsTarget = Nothing
Set ws = Nothing
On Error GoTo 0
End Sub