Bonjour,
J'ai trouvé la solution, cela a été laborieux mais c'est bon.
Merci pour tout.
Cordialement.
ericp
Option Explicit
Public Sub Créer_reps()
Dim lig As Long, rep As String, nbc(3)
Dim CHX As FileDialog ' selection Repertoire
Set CHX = Application.FileDialog(msoFileDialogFolderPicker)
CHX.Show
On Error Resume Next
rep = CHX.SelectedItems(1)
If Err.Number <> 0 Then Exit Sub
For lig = 2 To Cells(Rows.Count, 1).End(xlUp).Row
MkDir (rep & "\" & Cells(lig, 1).Value)
If Err.Number = 0 Then nbc(1) = nbc(1) + 1 Else Err.Clear
MkDir (rep & "\" & Cells(lig, 1).Value _
& "\" & Cells(lig, 2).Value)
If Err.Number = 0 Then nbc(2) = nbc(2) + 1 Else Err.Clear
If Cells(lig, 3).Value <> "" Then
MkDir (rep & "\" & Cells(lig, 1).Value _
& "\" & Cells(lig, 3).Value)
MkDir (rep & "\" & Cells(lig, 1).Value _
& "\" & Cells(lig, 4).Value)
MkDir (rep & "\" & Cells(lig, 1).Value _
& "\" & Cells(lig, 5).Value)
MkDir (rep & "\" & Cells(lig, 1).Value _
& "\" & Cells(lig, 6).Value)
MkDir (rep & "\" & Cells(lig, 1).Value _
& "\" & Cells(lig, 7).Value)
If Err.Number = 0 Then nbc(3) = nbc(3) + 1 Else Err.Clear
End If
Next lig
MsgBox nbc(1) & " Dossiers créés" & vbLf _
& nbc(2) & " Sous-dossiers 1 créés" & vbLf _
& nbc(3) & " Sous-dossiers 2 créés"
End Sub