Option Explicit
Sub test()
Dim Base$, I&, Sd&
Base = ThisWorkbook.Path & "\ARCHIVE\" 'dossier racine a adapter
If Dir(Base, vbDirectory) = "" Then MkDir Base 'creation du dossier racine si il existe pas
For I = 3 To Cells(Rows.Count, 1).End(xlUp).Row 'boucle sur cellule "A"
If Dir(Base & Cells(I, 1).Text & "\", vbDirectory) = "" Then 'test d 'existence du dossier en cells(i,"A")
MkDir Base & Cells(I, 1).Text & "\" ' creation si il existe pas
For Sd = 1 To 3 ' boucle de 1 a 3 et test si le dossier 1,2,3 existe ;si existe pas on le crée
If Dir(Base & Cells(I, 1).Text & "\DOSSIER" & Sd & "\", vbDirectory) = "" Then MkDir Base & Cells(I, 1) & "\DOSSIER" & Sd
Next Sd
End If
Next I
End Sub