Leere Zeilen überspringen in Makro

Option Explicit
Sub Umbenennen()
Dim Dlg As FileDialog, FSO As Object
Dim PfadAlt As String, PfadNeu As String, Datei, Anz As Long
Dim Ext As String, DatNeu As String
Dim Sp As Integer, Ze As Long, LR As Long
PfadAlt = "C:\"
Ext = ".pdf"
Sp = 5 'Spalte für den Dateinamen der PDFs
Set Dlg = Application.FileDialog(msoFileDialogFolderPicker)
Dlg.InitialFileName = PfadAlt
If Dlg.Show = True Then
PfadAlt = Dlg.SelectedItems(1) & "\"
PfadNeu = PfadAlt & "umgewandelt\"
If Dir(PfadNeu, vbDirectory) = "" Then
MkDir PfadNeu ' wenn Pfad nicht vorhanden, dann anlegen
End If
LR = Cells(Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
For Ze = 10 To LR
Datei = Cells(Ze, Sp)
If Dir(PfadAlt & Datei)  "" Then 'Datei vorhanden
'neuer Dateiname
DatNeu = Cells(Ze, 2) & "." & Cells(Ze, 3) & "." & Cells(Ze, 4) & Ext
'umbenennen und kopieren
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.copyFile PfadAlt & Datei, PfadNeu & DatNeu
Anz = Anz + 1
'nochmal vorhanden?
If WorksheetFunction.CountIf(Cells(Ze + 1, Sp).Resize(LR - Ze + 1, 1), Datei) = 0 Then
'wenn letzte Kopie, dann erst löschen
FSO.deletefile PfadAlt & Datei
End If
Else
Exit Sub
End If
Next
Else
MsgBox "Es wurde kein Ordner zum Umbenennen von PDF-Dateien ausgewählt"
End If
MsgBox Anz & "  Dateien umbenannt"
Set FSO = Nothing
End Sub