Création d'un dossier unique avec 1 sous dossier défini dedans

bonsoir à tous,

j'ai fait beaucoup de recherches mais je n'ai trouvé que des demandes compliquées (avec beaucoup de sous dossiers, boucles,,etc...) que je n'arrive pas à adapter à ce que je veux, qui me semble pourtant plus simple.

j'ai fait une macro pour créer un dossier qui prends le nom d'une cellule (le contenu varie selon une formule recherchev), mais je voudrais qu'il se crée en même temps un sous dossier dans ce dossier avec toujours le même nom, "FRAIS".

voici mon code : (j'avais récupéré le code fonction sur internet, je ne l'ai pas créé moi-même je suis trop novice pour ça)

Sub creer_dossier()

ActiveCell.Select
Selection.Copy
Sheets("TEMP CTN").Select
ActiveSheet.Paste
Sheets("CTN").Select

chemindossier = "L:\OVERSEAS\GRA\0 - MARITIME\1 - IMPORTS MARITIMES\1 - CONTENEURS\"

MkDir (chemindossier & Sheets(4).Range("A27").Value)

MsgBox ("Dossier créé.")

End Sub

Function FolderExists(FolderPath As String) As Boolean
On Error Resume Next
FolderExists = (GetAttr(FolderPath) And vbDirectory) = vbDirectory
On Error GoTo 0
End Function

je voudrais créer automatiquement un sous dossier "FRAIS" à chaque nouveau dossier que je crée avec la nouvelle valeur de la cellule A27.

Pourriez vous m'aider svp ?

merci

Bonjour,

J'ai regardé ton code et je ne comprend pas ce que tu veux faire (voir commentaires dans le code)

Sub creer_dossier()

ActiveCell.Select  ' ici on sélectionne une cellule
Selection.Copy     ' là on la copie
Sheets("TEMP CTN").Select ' On passe sur la feuille "TEMP CTN"
ActiveSheet.Paste  ' on copie le contenu de la cellule (on ne sait pas où !!)
Sheets("CTN").Select ' on passe sur la feuille "CTN"

chemindossier = "L:\OVERSEAS\GRA\0 - MARITIME\1 - IMPORTS MARITIMES\1 - CONTENEURS\"

MkDir (chemindossier & Sheets(4).Range("A27").Value) ' on créé le dossier avec comme nom le contenu de la cellule A27
                                                     ' de la feuille 4
                                                     ' Cette feuille existe ?? que contient le cellule A27 ??

MsgBox ("Dossier créé.")

End Sub

A quoi sert la Function FolderExists ?

Pour créer un sous dossier "Frais" dans le dossier créé il suffit de répéter l'instruction Mkdir avec le nouveau chemin

MkDir (chemindossier & Sheets(4).Range("A27").Value & "\FRAIS)

sous réserve que la cellule A27 soit conforme.

Dernière observation : les espaces sont fortement déconseillés dans le nom des feuilles, cela peut provoquer des anomalies dans le recalcul des formules.

Voir mon post : Eviter les espaces dans le nom d'une feuille de calcul - Communauté Microsoft

Bonne journée

Eric

Salut

merci de ta réponse

pour la fonction j'avais recopié ce code que j'avais trouvé quand j'avais cherché pour créer un dossier.

je l'ai supprimé s'il ne sert à rien. (comme je suis novice fais beaucoup de copie coller de j'adapte ;))

en fait je modifie ma valeur A27 en fonction de la cellule active choisie sur 1 première feuille qui se combine avec une autre donnée sur ma feuille "TEMP CTN" (déterminée par recherchev)

j'a rajouté la cellule de destination de copie dans mon code, et j'ai ajouté ta partie (il manquait un guillemet après "_\FRAIS)

c'est parfait le code fonctionne !

je vais voir pour supprimer les espaces des noms de mes onglets alors.

je te remercie pour ton aide :)

voici le code maintenant :

Sub creer_dossier()

ActiveCell.Select 'sur ma feuille de départ
Selection.Copy
Sheets("TEMP CTN").Select
Range("A1").Select 'je colle la ref sur ma feuille qui regroupe mes calculs
ActiveSheet.Paste
Sheets("CTN").Select 'je reviens à ma feuille initiale

chemindossier = "L:\OVERSEAS\GRA\0 - MARITIME\1 - IMPORTS MARITIMES\1 - CONTENEURS\"

MkDir (chemindossier & Sheets(4).Range("A27").Value)
MkDir (chemindossier & Sheets(4).Range("A27").Value & "\FRAIS")
MsgBox ("Dossier créé.")

End Sub

bonne journée

Re,

Tu peux remplacer :

ActiveCell.Select 'sur ma feuille de départ
Selection.Copy
Sheets("TEMP CTN").Select
Range("A1").Select 'je colle la ref sur ma feuille qui regroupe mes calculs
ActiveSheet.Paste

Par :

Sheets("TEMP CTN").Range("A1")=ActiveCell.Value

Le résultat sera le même.

Concernant la création des dossiers et sous dossiers, il serait bon d'ajouter un test sur d'éventuelles erreurs (chemin introuvable, erreur dans le nom etc.)

Par exemple :

On Error Resume Next
Mkdir ....
i=Err.number
On Error goto 0
if i<>0 then
        ' Erreur à la création
        ' Gestion de l'erreur
end if
' Pas d'erreur on continue

A+

Merci !

voici mon code final grâce à tes conseils :

Sub creer_dossier()

Sheets("TEMP GRP").Range("A1") = ActiveCell.Value

chemindossier = "L:\OVERSEAS\GRA\0 - MARITIME\1 - IMPORTS MARITIMES\2 - GROUPAGES\"

On Error Resume Next

MkDir (chemindossier & Sheets(3).Range("A27").Value)
MkDir (chemindossier & Sheets(3).Range("A27").Value & "\FRAIS")

i = Err.Number
On Error GoTo 0
If i <> 0 Then

MsgBox ("Dossier déjà créé !")
' Erreur à la création
' Gestion de l'erreur

Else
MsgBox ("Dossier créé.")

End If
' Pas d'erreur on continue

End Sub

bonne soirée !

Bonjour,

Pour la gestion des erreurs, on peut être un peu plus précis. Dans ton code on ne sait pas quelle erreur est générée (si erreur) ni si elle concerne la création du dossier principal ou du sous-dossier. L'action à mener sera différente selon l'erreur détectée (espace insuffisant, dossier verrouillé, chemin inexistant, etc.)

Voici un exemple où on affiche l'erreur détectée (si erreur), à chaque étape :

' Création du 1er dossier
On Error Resume Next
MkDir (chemindossier & Sheets(3).Range("A27").Value)
i = Err.Number: a$ = Err.Description
On Error GoTo 0 ' Réinitialise Err.Number à 0
If i <> 0 Then
    MsgBox "Erreur : " & i & "  " & a$, vbCritical, "Erreur lors de la création du dossier principal."
Else
    ' Dossier principal créé : Création du sous dossier (sinon sort)
    On Error Resume Next
    MkDir (chemindossier & Sheets(3).Range("A27").Value & "\FRAIS")
    i = Err.Number: a$ = Err.Description
    On Error GoTo 0
    If i <> 0 Then
        MsgBox "Erreur : " & i & "  " & a$, vbCritical, "Erreur lors de la création du sous-dossier."
    End If
End If

If i <> 0 Then Exit Sub ' Erreur, Abandon de la procédure

' Dossiers créés ...

Bonne journée

Eric

Ok merci pour l'info je vais regarder ça

en tout cas merci beaucoup je gagne beaucoup de temps pour créer mes dossiers !

bonne journée