Spezailfilter "vergisst" Datenzeilen

Option Explicit
Sub Filtern()
Dim Zei As Long, colC As New Collection, C As Long, wksH As Worksheet
On Error Resume Next
Set wksH = Worksheets("Hilf")
With Worksheets("Tabelle1")
Zei = .Cells(Rows.Count, 1).End(xlUp).Row
On Error Resume Next 'wg. colc
For C = 2 To Zei
colC.Add key:=CStr(.Cells(C, 5).Value), Item:=CStr(.Cells(C, 5).Value)
Next C
On Error GoTo 0
Application.DisplayAlerts = False
For C = ThisWorkbook.Worksheets.Count To 1 Step -1
If ThisWorkbook.Worksheets(C).Name Like "Geb*" Then
ThisWorkbook.Worksheets(C).Delete
End If
Next C
Application.DisplayAlerts = True
For C = 1 To colC.Count
Worksheets.Add.Name = "Geb." & Right("000" & colC(C), 3)
Next C
For C = 1 To colC.Count
wksH.Range("E2") = colC(C)
.Range("A1:E" & Zei).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=wksH.Range("A1:E2"), _
CopyToRange:=Worksheets("Geb." & Right("000" & colC(C), 3)).Range("A1")
Next C
.Move Before:=Sheets(1)
End With
End Sub