Überprüfung der gefundenen Dateien

Sub Kopieren2()
Dim rngRange As Range
Dim sDir$
Dim lngCreatePath&
Dim Pfad As String
Dim zPfad As String
Dim Dateiname As String
'Bereich
Set rngRange = Tabelle1.Range("B9:I16")
'Pfad Quelle
'Const sPathQuelle$ = "XXX"
Pfad = ThisWorkbook.Sheets("Tabelle1").Range("B26")
'Pfad Ziel
'Const sPathZiel$ = "XXX"
zPfad = ThisWorkbook.Sheets("Tabelle1").Range("B30")
'Ordner anlegen wenn nicht vorhanden
lngCreatePath = apiCreateFullPath(Left$(zPfad, InStrRev(zPfad, "\")))
If lngCreatePath = 1 Then
For Each rngRange In rngRange.Cells
If rngRange.Value  "" Then
sDir = Dir$(Pfad & rngRange.Value & "*.txt", vbNormal)
If sDir  "" Then
FileCopy Pfad & sDir, zPfad & sDir
End If
End If
Next rngRange
MsgBox "Fertig"
Else
MsgBox "Ordner konnte nicht angelegt werden!", vbCritical
End If
End Sub