XL 2016 Vba mkdir dossier source

Bonsoir à tous,
Je suis nouveau sur ce forum, et nouveau en vba.. très prenant!
J'ai un soucis dans une commande, j'essaie de créer les dossiers et sous-dossiers (répétitif, comme suit: ville(nom de la ville), puis en sous-dossier par ville plusieurs dossiers).
Jusque-là, tout va bien,ça fonctionne. Par contre, comment puis-je sélectionner un dossier cible? Pour l'instant, cela ne marche que dans le dossier ou j'ai mon tableur.
J'ai pensé au gestionnaire de nom pour choisir le dossier cible, rien n'y fait.. J'essaie mais je m'arrache des cheveux!
Voici ce que j'ai mis en code, si qq un arrive à m'éclairer, je suis preneur pour comprendre!
Belle soirée à tous, Nicolas

Sub CreationChemin()
Dim Chemin As String
With Application.FileDialog(msoFileDialogFolderPicker)
'Définit un titre pour la boîte de dialogue
.Title = "Selectionner un lecteur et un dossier de sauvegarde"
.Show
'Affiche le nom du dossier sélectionné
If .SelectedItems.Count > 0 Then
Chemin = .SelectedItems(1) & "\"
ActiveWorkbook.Names.Add Name:="Emplacement", RefersTo:=Chemin
'Msgbox ==>facutatif
MsgBox "L'emplacement du dossier choisi est:" & vbLf & Chemin & vbLf & "Il est stoché sous le nom : ''Emplacement'' dans le gestionnaire des noms", , "Information"
Else
MsgBox "Abandon", , "information"
End If
End With
End Sub


Sub CreationRepertoires()

On Error Resume Next
i = 1
While Cells(i, 1).Value <> ""
MkDir ActiveWorkbook.Path & ActiveWorkbook.Names("emplacement") & Cells(i, 1).Value
For j = 2 To 9
MkDir ActiveWorkbook.Path & ActiveWorkbook.Names("emplacement") & Cells(i, 1).Value & "\" & Cells(i, j).Value
Next j
i = i + 1
Wend
End Sub