Microsoft 365 Création de sous dossier dans dossier aléatoire

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

jamespatagueul

XLDnaute Occasionnel
Bonjour à tous,

Je cherche à créer en VBA des sous sous dossiers ( NOM Prénom) dans différents dossiers.
J'ai déjà créer l'arborescence, je souhaite donc maintenant pouvoir créer le reste selon un onglet.

structure :
colonne A : NOM
colonne B : Prénom
colonne C : Etablissement (5 différents)
départ de la liste de A3 à A xxx (évolutif)

arborescence : thisworkbook\annee\sites\

Comment en VBA pouvoir créer les dossiers NOM Prénom dans chaque sites qui convient.

Merci à tous
 
Bonjour
c'est assez simple en fait
VB:
Option Explicit
Sub createfolder()
    Dim Fparent$, i&, q&, chemin$, t, D$ 'variable
    
    Fparent = ThisWorkbook.Path & "\annee\sites" 'chemin de base
    
    With Feuil1 'object feuille a adapter
        
        For i = 3 To Feuil1.Cells(Rows.Count, 1).End(xlUp).Row
            
            'chemin = la base & "\" & .la colonne 3 & "\" & lacolonne 1 et 2
            
             chemin = Fparent & "\" & .Cells(i, 3) & "\" & .Cells(i, 1) & " " & .Cells(i, 2) 'concat
            
            t = Split(chemin, "\") 'recoupe
            
            D = t(0) 'd=le premier dossier dans la base
            
            For q = 1 To UBound(t) 'boucle a partir du 2d segment du chemin
                
                D = D & "\" & t(q) 'concat progressif  avec separateur"\"
                
                If Dir(D, vbDirectory) = "" Then MkDir (D) 'test d'existance et creation si il le faut
            
            Next
        
        Next
    
    End With

End Sub
je joins un fichier exemple
 

Pièces jointes

Bonjour
c'est assez simple en fait
VB:
Option Explicit
Sub createfolder()
    Dim Fparent$, i&, q&, chemin$, t, D$ 'variable
   
    Fparent = ThisWorkbook.Path & "\annee\sites" 'chemin de base
   
    With Feuil1 'object feuille a adapter
       
        For i = 3 To Feuil1.Cells(Rows.Count, 1).End(xlUp).Row
           
            'chemin = la base & "\" & .la colonne 3 & "\" & lacolonne 1 et 2
           
             chemin = Fparent & "\" & .Cells(i, 3) & "\" & .Cells(i, 1) & " " & .Cells(i, 2) 'concat
           
            t = Split(chemin, "\") 'recoupe
           
            D = t(0) 'd=le premier dossier dans la base
           
            For q = 1 To UBound(t) 'boucle a partir du 2d segment du chemin
               
                D = D & "\" & t(q) 'concat progressif  avec separateur"\"
               
                If Dir(D, vbDirectory) = "" Then MkDir (D) 'test d'existance et creation si il le faut
           
            Next
       
        Next
   
    End With

End Sub
je joins un fichier exemple
Bonsoir,
et merci de ton aide.
J'ai réadapter à mon contexte, et nikel.
 
Bonjour à tous,
je déterre ce post, car l'arborescence a changée, et je n'arrive pas a adapter.

nouvelle arborescence : thisworkbook\annee\sites\etablissement 1 ou 2 ou 3 ...\essai\equipe & "etablissement 1 ou 2 ou 3 ..."\

je souhaiterai que dans le dossier final soit creer les dossiers nominatifs, comme le fichier exemple fournir par patricktoulon, qui fonctionne a merveille, mais avec la nouvelle arborescence.

Merci de votre aide
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
742
Réponses
1
Affichages
700
Retour