XL 2016 Création de plusieurs dossiers suivant liste

[dindin]

Bonjour le forum,
Comment peut on adapter ce code en rajoutant une boucle qui nommera les dossiers suivant une liste bien définie à l'avance se trouvant dans une feuille "Feuil1".
désolé le code est trop long.
Pouvez vous m'aider à le réduire
je joins le fichier
Merci pour votre aide

 

[sylvanu]

Bonjour Dindin,
Que signifie :

Range("annee").Value

Ce n'est ni une variable, ni le nom d'une cellule.

 

[dindin]

Bonjour Dindin,
Que signifie :

Range("annee").Value

Ce n'est ni une variable, ni le nom d'une cellule.

Bonjour sylvanu,
dans le fichier d'origine il s'agît du nom d'une cellule .

comme j'ai fait copier coller du code dans un nouveau fichier j'ai oublié les cellules nommées.
ou cas j'adapterai le code.

 

[job75]

Bonjour dindin, sylvanu,

J'avoue ne pas avoir étudié votre code, à partir de ce que vous dites au post #1 :

Sub création()
Dim chemin$, r As Range
chemin = ThisWorkbook.Path & "\"
Set r = [A1:A7] 'plage à adapter
For Each r In r
    If r <> "" Then If Dir(chemin & r, vbDirectory) = "" Then MkDir chemin & r
Next
End Sub

A+

 

[dindin]

Bonjour dindin, sylvanu,

J'avoue ne pas avoir étudié votre code, à partir de ce que vous dites au post #1 :

Sub création()
Dim chemin$, r As Range
chemin = ThisWorkbook.Path & "\"
Set r = [A1:A7] 'plage à adapter
For Each r In r
    If r <> "" Then
        If Dir(chemin & r, vbDirectory) = "" Then MkDir chemin & r
    End If
Next
End Sub

A+

Bonjour job75
c'est exactement ça.
excellent travail
Grand merci

 

[job75]

J'ai modifié ma macro juste après que vous la copiez, elle est un peu plus simple.

 

[dindin]

J'ai modifié ma macro juste après que vous la copiez, elle est un peu plus simple.

le voici adapté et testé

' Création des dossiers

Private Sub CommandButton26_Click()

Dim chemin$, r As Range
chemin = ThisWorkbook.Path & "\"
Set r = [Liste_dossier] 'plage à adapter
For Each r In r
    If r <> "" Then
        If Dir(chemin & r, vbDirectory) = "" Then MkDir chemin & r
    End If
Next

End Sub

Merci

 

[job75]

Avec ma macro post #4 le End if a été enlevé car les tests sont sur une ligne.

 

[dindin]

Avec ma macro post #4 le End if a été enlevé car les tests sont sur une ligne.

Ah oui ok