Création de dossiers et sous repertoires depuis liste

Bonjour le forum,

J'ai besoin de vos lumières !

Je cherche un moyen de créer en un clic plusieurs dizaines de dossier et sous dossiers, depuis une base définie.

Sauf que c'est plus difficile que ce que je pensais...

Voici un fichier simplifié qui reprend à l'identique la structure de ma base.

J'ai mon répertoire principal : "C:\Users\Documents\test\"

Dans ce répertoire, je vous voudrai un dossier "PAYS"

Dans le dossier "PAYS" je voudrai un dossier "MARQUE"

Puis, dans le dossier "MARQUE", je voudrai un dossier "MODELE".

Ce qui donnerai : "C:\Users\Documents\test\PAYS\MARQUE\MODELE"

Sachant que je peux avoir plusieurs marques pour un pays et plusieurs modèles pour une marque. un casse tête...

Si quelqu'un peut m'aider, un GRAND merci d'avance !!

26test-dossier.xlsm (14.63 Ko)

Bonjour,

un essai à tester:

Sub Tst()
Dim PAYS As String, MARQUE As String, MODELE As String, RepSource As String
Dim Ligne As Long, MaxLigne As Long
MaxLigne = Range("A" & Rows.Count).End(xlUp).Row
RepSource = "C:\Users\Documents\test\"

For Ligne = 2 To MaxLigne
    PAYS = RepSource  & Range("A" & Ligne).Value
    MARQUE = PAYS & Range("B" & Ligne).Value
    MODELE = MARQUE  & Range("C" & Ligne).Value

    If Dir(PAYS, vbDirectory) = "" Then MkDir PAYS
    If Dir(MARQUE, vbDirectory) = "" Then MkDir MARQUE
    If Dir(MODELE, vbDirectory) = "" Then MkDir MODELE
Next Ligne
End Sub

A+

Bonjour AlgoPlus,

Je te remercie pour ta réponse.

J'ai testé mais ça ne fonctionne pas vraiment (voir capture)

Je vais essayer de bidouiller un peu, je sens que la solution n'est pas loin !

Merci encore !

capturedossier

Oups, je ne sais comment ça avait pu fonctionner.

La correction:

Sub Tst()
Dim PAYS As String, MARQUE As String, MODELE As String, RepSource As String
Dim Ligne As Long, MaxLigne As Long
MaxLigne = Range("A" & Rows.Count).End(xlUp).Row
RepSource = "C:\Users\Documents\test\"

For Ligne = 2 To MaxLigne
    PAYS = RepSource & Range("A" & Ligne).Value
    MARQUE = PAYS & "\" & Range("B" & Ligne).Value          ' rajout \
    MODELE = MARQUE & "\" & Range("C" & Ligne).Value    ' rajout \

    If Dir(PAYS, vbDirectory) = "" Then MkDir PAYS
    If Dir(MARQUE, vbDirectory) = "" Then MkDir MARQUE
    If Dir(MODELE, vbDirectory) = "" Then MkDir MODELE
Next Ligne
End Sub

Merci beaucoup c'est parfait !!

Rechercher des sujets similaires à "creation dossiers repertoires liste"