XL 2019 Création de dossiers selon feuille

[litelsousa]

Bonjour,
J'ai un petit soucis pour créer des dossiers.
J'avais reçu un code pour les créer selon une feuille.

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

Il y a les dossier principaux (colonne A)
Les sous dossiers (colonnes B à ........).
Mon soucis est que pour les sous-dossiers, ce code s'arrête à la colonne 8. J'aimerais que ça se fasse jusqu'à la dernière colonne remplie.

Je vous remercie pour votre aide

 

[litelsousa]

C'est nickel
Un grand merci

 

[GALOUGALOU]

re
le code n'est pas correct, il est à revoir, je vais supprimer le fil
pourriez vous précisez comment sont créées les sous dossiers, le plus simple poster un classeur exemple (sans aucunes données confidentielles) avec le résultat attendu
cdt
galougalou

 

[GALOUGALOU]

re
à la relecture il me semble que le code ci-dessous est plus adapté à votre problèmatique

    Sub CreationRepertoires()
    Dim dercol As Long
   
    On Error Resume Next
    i = 1
    While Cells(i, 1).Value <> ""
    MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value
     dercol = Cells(i, Cells.Columns.Count).End(xlToLeft).Column
   
    For j = 2 To dercol
    MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value
    Next j
    i = i + 1
    Wend
    End Sub

cdt
galougalou

 

[litelsousa]

Pourtant ça marche très bien.

J'ai mis le dossier à faire.
Par contre, je suis en train d'essayer de le modifier pour le faire selon la feuille autre solution

 

[litelsousa]

J'avais pas vu ta réponse...

La première version marche mieux, la deuxième me met des fenêtres à valider.

 

[GALOUGALOU]

re
c'est dû à une msgbox qui m'a permis de contrôler l'exécution du code. je l'ai supprimé dans le fil 4
cela devrait fonctionner sans alerte maintenant. par contre vous avez raison, le code n'est pas nickel, pour l'instant la première version devrait mieux convenir. je vais tester ce soir pour trouver une réponse que je n'ai pas pour l'instant.
cdt

 

[GALOUGALOU]

re
je n'avais pas vu que dans votre classeur il y avait des sous dossier en doublons. la macro ne créée pas de sous dossier doublon.
l'avantage du code présenté dans le fil 4, c'est d'aligner ligne par ligne à la dernière colonne avec données.
cdt
galougalou

 

[kiki29]

Salut, une approche à tester en l'adaptant au contexte.

Option Explicit

Sub tst()
Dim sDoss As String
    sDoss = "C:\Essai1\Essai2\Essai3\Essai4\Essai5"
    CreationDossier sDoss
End Sub

Private Sub CreationDossier(sDossier As String)
Dim sChaine As String
    sChaine = Environ("comspec") & " /c mkdir " & sDossier
    Shell sChaine, 0
End Sub