XL 2019 Création de dossiers selon feuille

litelsousa

XLDnaute Occasionnel
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
 

GALOUGALOU

XLDnaute Accro
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

XLDnaute Accro
re
à la relecture il me semble que le code ci-dessous est plus adapté à votre problèmatique
VB:
    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
 
Dernière édition:

GALOUGALOU

XLDnaute Accro
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
 
Dernière édition:

GALOUGALOU

XLDnaute Accro
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

XLDnaute Barbatruc
Salut, une approche à tester en l'adaptant au contexte.
VB:
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
 
Dernière édition:

Discussions similaires

Réponses
6
Affichages
202
Réponses
17
Affichages
760

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla