Création de répertoires et sous répertoire à partir d'une liste Excel

Bonsoir à tous,

Je vous écrit ce soir en espérant que vous allez pouvoir m'aider à trouver une solution à mon pb j'y ai passé l'après midi et rien ne fonctionne... :(

Je pensais que mon pb était simple pourtant ...

Salut Anais83,

voici un code qui peut être adapter, le problème c'est que quand la céllule A est vide, comment peut on savoir sous quel répertoire Mère doit on créer le répertoire fille?

Sub créer_dossiers()
    Dim ws As Worksheet
    Dim strFolderPath, strFolderChildPath As String
    Dim LastRow, i As Long

    LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row

    For i = 2 To LastRow

        If ws.Range("A" & i).Value <> "" Then
            strFolderPath = "C:\Users\D\Desktop\Pilotage documentaire EXE\6001_Marché 5_ Livrables\" & ws.Range("A" & i).Value
            CheckDir (strFolderPath)
        End If
        If ws.Range("B" & i).Value <> "" And ws.Range("A" & i).Value <> "" Then
            strFolderChildPath = "C:\Users\D\Desktop\Pilotage documentaire EXE\6001_Marché 5_ Livrables\" & ws.Range("A" & i).Value & "\" & ws.Range("B" & i).Value
            CheckDir (strFolderChildPath)
        End If
    Next i

End Sub

Function CheckDir(Path As String)

    If Dir(Path, vbDirectory) = "" Then
        MkDir (Path)
        MsgBox "Making Directory!"
    Else
        MsgBox "Dir Exists!"
    End If

End Function

@+++

Bonjour le fil et le forum,

c'est plus facile si on remplit toujours la colonne A même si le dossier existe déjà, voici le code:

Sub créer_dossiers()
'https://forum.excel-pratique.com/excel/creation-de-repertoires-et-sous-repertoire-a-partir-d-une-liste-excel-176934

Const Mere As String = "C:\Users\D\Desktop\Pilotage documentaire EXE\6001_Marché 5_ Livrables\"

Dim Dossier As String, SousDossier As String
Dim cel As Range

For Each cel In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)

Dossier = Mere & cel.Value & "\"
SousDossier = Dossier & cel.Offset(o, 1).Value

With CreateObject("Scripting.FileSystemObject")
    If Not .FolderExists(Dossier) Then .CreateFolder Dossier
     If Not .FolderExists(SousDossier) Then .CreateFolder SousDossier
End With

Next cel

End Sub

Bonjour à tous
Merci à tous les deux pour votre aide :) ,

Oui j'avais laissé des cellule de la colonne A vide car je ne voulais pas recrée le répertoire mère lorsque celui ci existe déja pour ne pas avoir de doublon mais je peux adapter ma macro poru que la colonne A soit toujours remplie si c'est plus simple.

Par contre le problème c'est que le chemin où doit se créer le répertoire ne sera pas toujours le même , celui ci est indiqué dans la colonne C , est il possible d'adapter la macro pour lui dire d'aller récupérer le chemin indiqué dans la Colonne C ?

Merci pour vos conseils !

Bonne journée à vous
A.

Bonjour Anais83,

voici le code modifié, à tester

Sub créer_dossiers2()

Dim Dossier As String, SousDossier As String, Mere As String
Dim cel As Range

For Each cel In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)

Mere = cel.Offset(0, 2).Value & "\" 'Colonne C
Dossier = Mere & cel.Value & "\" 'Colonne C + Colonne A
SousDossier = Dossier & cel.Offset(0, 1).Value ''Colonne C + Colonne A + Colonne B

With CreateObject("Scripting.FileSystemObject")
    If Not .FolderExists(Mere) Then .CreateFolder Mere
    If Not .FolderExists(Dossier) Then .CreateFolder Dossier
    If Not .FolderExists(SousDossier) Then .CreateFolder SousDossier
End With

Next cel

End Sub

Cordialement

Bonjour Sequoyah ,

Merci beaucoup pour ton aide ça fonctionne :D

Bonne soirée !

Anaïs