Option Explicit
Dim j As Long, lz1 As Long
Sub Daten_übertragen()
Dim Jahr As Variant
Dim ZSht As Worksheet, zX As Long
Set ZSht = Worksheets("Tabelle2")
Jahr = InputBox("Bitte Jahr eingeben")
If Jahr = vbCancel Then Exit Sub
On Error GoTo Fehler
With Worksheets("Tabelle1")
lz1 = .Cells(Rows.Count, 1).End(xlUp).Row
zX = ZSht.Cells(Rows.Count, 1).End(xlUp).Row + 1
For j = 2 To lz1
If InStr(.Cells(j, 1), Jahr) Then
.Rows(j).Cut ZSht.Rows(zX)
zX = zX + 1
End If
Next j
For j = lz1 To 2 Step -1
If .Cells(j, 1) = Empty Then
.Rows(j).Delete shift:=xlUp
End If
Next j
End With
Exit Sub
Fehler: MsgBox "unerwarteter Gehler aufgetreten - Abbruch"
End Sub