XL 2013 Création de dossier , sous dossiers......

Sub dossiersJJ()
    Dim i&, J&, K&, Lecteur$
    On Error Resume Next
    Lecteur = "D:\"     '  **** adapter le chemin de départ commun ****
    For i = 1 To 5
        MkDir Lecteur & Cells(i, 1)
        For J = 2 To 4
            MkDir Lecteur & Cells(i, 1) & "\" & Cells(i, J)
            For K = 1 To 9
                MkDir Lecteur & Cells(i, 1) & "\" & Cells(i, J) & "\" & Cells(K, J)
            Next
        Next
    Next
End Sub

Sub CreationDossier()
Dim sDossier As String
Dim sChaine As String
    sDossier = "C:\Essai1\Essai2\Essai3\Essai4\Essai5"
    sChaine = Environ("comspec") & " /c mkdir " & sDossier
    Shell sChaine, 0
End Sub

Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, _
                                              ByVal pszPath As String, _
                                              ByVal lngsec As Long) As Long

Option Explicit

Private Function CreationDossier_01(sDossier As String) As Long
Dim Rep As Long
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
End Function