VBA löscht die Zellen nicht

Sub Test()
Worksheets("Test").Unprotect Password:="xy"
Dim s As String, wbCopy As Workbook, varLink As Variant
Worksheets("Test").Copy
s = "c:\test\Test  " & Format(Now, "yyyy_mm_dd_hhmmss")
Set wbCopy = ActiveWorkbook
With wbCopy
.SaveAs Filename:=s, FileFormat:=xlExcel8
For Each varLink In .LinkSources(Type:=xlExcelLinks)
.BreakLink Name:=varLink, Type:=xlExcelLinks
Next
Dim loeschen As Double
For loeschen = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Cells(loeschen, 1).Value = "" Then
Rows(loeschen).Delete
End If
Next loeschen
.Close savechanges:=True
End With
Set wbCopy = Nothing
varLink = Null
Worksheets("Test").Protect Password:="xy"
End Sub