Création dossiers imbriqués

bambi · 23 Février 2016

Bonjour à tous

A partir de noms dans un fichier excel, je tente de créer par macro 264 dossiers aux noms différents
Chaque dossiers contient 2 sous-dossiers tous identiques au nom de "Pommes" et "Poires"
Chaque sous-dossiers contient à son tour 2 sous-sous dossiers tous identiques au nom de "Prix" et "Quantité"

J'ai essayé d"adapter une macro trouvée ici
J'arrive à créer les 264 dossiers aux noms différents et les sous-dossiers Pommes et Poires à l’intérieur
Mais pas les sous-sous dossiers "Prix" et "Quantité" dans les dossiers Pommes et Poires

Merci de votre aide

Code:

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

sousou · 24 Février 2016

Re : Création dossiers imbriqués

Bonjour à tous
désolé, pour le zc! cette une fonction que j'utilise et que j'ai oublié de te fournir, mais sont résultat est, dans ton cas, la même chose
que la première ligne de cathodique
Set zone = Sheets("Feuil1").Range("A1").CurrentRegion

sousou · 23 Février 2016

Re : Création dossiers imbriqués

Bonjour
en utilisant l'objet filesystem
voila ce que tu peux faire:
Ici les données ont feuil1 colonne 1 et les répertoire sont créés dans le répertoire du fichier excel
Sub deb()
chemin = ThisWorkbook.Path
Set zone = zc(Sheets("feuil1"), 1, 1)

Set fso = CreateObject("scripting.filesystemobject")
For Each i In zone
Set rep = fso.createfolder(chemin & "/" & i.Value)

Set reppomme = fso.createfolder(rep.Path & "\pommes")
Set reppoire = fso.createfolder(rep.Path & "\poires")
fso.createfolder (reppomme.Path & "\prix")
fso.createfolder (reppomme.Path & "\quantités")
fso.createfolder (reppoire.Path & "\prix")
fso.createfolder (reppoire.Path & "\quantités")

Next

End Sub

bambi · 23 Février 2016

Re : Création dossiers imbriqués

Merci sousou de t’intéresser à ma question
mais à quoi correspond zc dans Set zone = zc(Sheets("feuil1"), 1, 1)
Car j'ai une erreur de compilation

bambi · 23 Février 2016

Re : Création dossiers imbriqués

Une image de l'erreur

bambi · 24 Février 2016

Re : Création dossiers imbriqués

je n'ai pas réussi à trouver l'erreur dans la macro de sousou

Je remet mon fichier avec en module 1, ma macro initiale du 1er message de cette file
Mais elle ne fonctionne pas pour les sous-sous dossiers

Et en module 2, la macro de sousou avec une erreur de compilation

Merci d'avance de votre aide

cathodique · 24 Février 2016

Re : Création dossiers imbriqués

Bonjour,

essaies ceci

VB:

Sub deb()

chemin = ThisWorkbook.Path

Set zone = Sheets("Feuil1").Range("A1").CurrentRegion
Set fso = CreateObject("scripting.filesystemobject")
For Each i In zone
On Error Resume Next
Set Rep = fso.createfolder(chemin & "/" & i.Value)

Set reppomme = fso.createfolder(Rep.Path & "\pommes")
Set reppoire = fso.createfolder(Rep.Path & "\poires")
fso.createfolder (reppomme.Path & "\prix")
fso.createfolder (reppomme.Path & "\quantités")
fso.createfolder (reppoire.Path & "\prix")
fso.createfolder (reppoire.Path & "\quantités")

Next

End Sub

Attention! avec ce code si les dossiers existent déjà, ils seront tous écrasées.
Je ne connais pas la méthode fso, j'ai simplement corrigé l'erreur de sousou.

bambi · 24 Février 2016

Re : Création dossiers imbriqués

Merci beaucoup cathodique
ça fonctionne parfaitement

sousou · 24 Février 2016

Re : Création dossiers imbriqués

Bonjour à tous
désolé, pour le zc! cette une fonction que j'utilise et que j'ai oublié de te fournir, mais sont résultat est, dans ton cas, la même chose
que la première ligne de cathodique
Set zone = Sheets("Feuil1").Range("A1").CurrentRegion

bambi · 25 Février 2016

Re : Création dossiers imbriqués

Pas grave du tout sousou. Bonne journée et encore merci à vous deux pour votre aide

Création dossiers imbriqués

bambi

XLDnaute Occasionnel

sousou

sousou

XLDnaute Barbatruc

bambi

XLDnaute Occasionnel

bambi

XLDnaute Occasionnel

bambi

XLDnaute Occasionnel

Pièces jointes

cathodique

XLDnaute Barbatruc

bambi

XLDnaute Occasionnel

sousou

XLDnaute Barbatruc

bambi

XLDnaute Occasionnel

Discussions similaires