Zellwerte als Ordner erstellen, Leerzeichen

Sub OrdnerStapelanlage()
Dim Info As String
Dim Pfad As String
Dim LeZeile As Long
Dim Namensliste As Range
Dim Name As Range
Dim Ordner As String
Dim i As Integer
'[OPTIONAL] Benutzer-Info und Abbruchsmöglichkeit
Info = MsgBox("Für jeden in Spalte F ab Zeile 2 eingetragenen Namen " & _
"(Zellwert) wird nun ein Ordner in [D:\FLAG] angelegt." & vbCrLf & _
vbCrLf & "Das kann einige Zeit in Anspruch nehmen. Starten?", vbOKCancel, _
"Ordner Stapelanlage starten?")
If Info = vbCancel Then Exit Sub
'Hauptpfad in dem Ordner angelegt werden sollen
Pfad = PfadWahl
'Wenn Namensliste ggf. Leerzeilen enthält
LeZeile = ThisWorkbook.Worksheets("Tabelle1"). _
Cells(ThisWorkbook.Worksheets("Tabelle1").Rows.Count, 6).End(xlUp).Row
'Wo stehen die Ordnernamen
Set Namensliste = ThisWorkbook.Worksheets("Tabelle1").Range("F2:F" & LeZeile)
'Ordner nach Liste anlegen, ggf. "hochzählen"
For Each Name In Namensliste
Select Case Name.Value
Case Is = ""
'Leere Zellen überspringen
Case Else
Ordner = OrdnerSauber(Name.Value)
If Dir(Pfad & "\" & Ordner, vbDirectory) = "" Then
MkDir Pfad & "\" & Ordner
Else:
i = 2
Do Until Dir(Pfad & "\" & Ordner & "_" & i, vbDirectory) = ""
i = i + 1
Loop
MkDir Pfad & "\" & Ordner & "_" & i
End If
End Select
Next
'[OPTIONAL] Benutzer-Info und Hauptpfad nach Stapelanlage öffnen
Info = MsgBox("Ordner wurden angelegt. Verzeichnis wird geöffnet... ", vbInformation, _
"Stapelanlage abgeschlossen!")
Shell "Explorer.exe " & Pfad, vbNormalFocus
End Sub

Function OrdnerSauber(Name As String) As String
'Ordnernamen dürfen nur Buchstaben A-Z inkl. Umlaute enthalten
Dim i As Integer
Dim Klar As String
For i = 1 To Len(Name)
Select Case LCase(Mid(Name, i, 1))
Case Is = "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", _
"n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", _
Klar = Klar & Mid(Name, i, 1)
Case Else
Klar = Klar
End Select
Next i
OrdnerSauber = Klar
End Function

Function PfadWahl() As String
'Verzeichnis, in das Ordner per Stapelanlage erzeugt werden sollen, über
'Datei-Dialog wählen
Dim SuchDialog As FileDialog
Set SuchDialog = Application.FileDialog(msoFileDialogFolderPicker)
With SuchDialog
.Title = "Bitte Verzeichnis wählen"
.AllowMultiSelect = False
If .Show  -1 Then
MsgBox "Vorgang abgebrochen", vbInformation
Exit Function
Else: PfadWahl = .SelectedItems(1)
End If
End With
End Function