XL 2016 Création de dossiers à partir d'une Base de Données

[APPRENTI:)]

Tout à bord, merci à vous pour votre aide souvent précieuse !!!

Habituellement, j'arrive à obtenir ce que je souhaite avec des formules Excel. Mais pour ce dernier, je pense qu'il faut passer en VBA, et pour le coup, je n'y connais rien !
Je vous explique mon souhait :

J'ai créé une base de donnée qui renseigne des détails sur des clients.

Il y a 6 désignations différentes dans la Base de Données : CHANTIER, GROUPE, FOURNISSEUR, ENTREPRISE, ARCHITECTE, PARTICULIER qui correspondent à 6 Dossiers Types présents sur le bureau.
Puis une colonne nom.

Sur le bureau, en plus des 6 dossiers Types, il y a 6 dossiers pour recueillir les nouveaux dossiers.

L'idée est par exemple, lorsque j'ajoute un nom X avec la désignation CHANTIER dans la base de données, le dossier CHANTIER TYPE qui se trouve sur le bureau soit copié et renommé X puis placé dans le dossier CHANTIER.

Idem, si j'ajoute un nom Y avec la désignation FOURNISSEUR dans la base de données, le dossier FOURNISSEUR TYPE qui se trouve sur le bureau soit copié et renommé Y puis placé dans le dossier FOURNISSEUR.

Et cela pour les 6 désignations différentes.

J'ai créé un dossier avec les différents dossiers et fichiers, comment puis je vous l'envoyer ?

Merci a vous, et bon confinement !!

 

[job75]

mais la désignation CHANTIER par exemple en contient des différents.

Comme je l'ai dit CHANTIER TYPE contient des sous-dossiers, patricktoulon ne l'a pas vu.

 

[patricktoulon]

Ok job75 milles excuses
j'ai testé ceci devrait suffire

Sub test2()
    Dim OFSO, dossierAcopier$, Dossdestination$, nom$
    Set OFSO = CreateObject("Scripting.FileSystemObject")
    Base = ThisWorkbook.Path
    For i = 3 To Cells(Rows.Count, "A").End(xlUp).Row
        dossierAcopier = Base & "\" & UCase(Cells(i, "A")) & " TYPE"
        Dossdestination = Base & "\" & UCase(Cells(i, "A"))
        If Dir(Base & "\" & UCase(Cells(i, "A")), vbDirectory) = "" Then MkDir Base & "\" & UCase(Cells(i, "A"))
        nom = "pour " & Cells(i, "C")
        If Dir(Dossdestination & "\" & nom, vbDirectory) = "" Then
            OFSO.CopyFolder dossierAcopier, Dossdestination & "\" & nom, True   'copie du dossier dans son nouveau parent
        End If
    Next
End Sub

sensiblement la même chose

 

[job75]

Avec ce dossier (3) et cette macro les dossiers TYPE sont copiés et A B C... créés une seule fois :

Sub Renommer_Transferer()
Dim fso As Object, chemin$, tablo, i&, dossier1$, dossier2$, dossier3
Set fso = CreateObject("Scripting.FileSystemObject")
chemin = ThisWorkbook.Path & "\"
tablo = Feuil1.UsedRange.Resize(, 3)
For i = 3 To UBound(tablo)
    If tablo(i, 1) <> "" And tablo(i, 3) <> "" Then
        dossier1 = chemin & UCase(tablo(i, 1))
        dossier2 = dossier1 & " TYPE"
        dossier3 = dossier1 & "\" & tablo(i, 3)
        If Dir(dossier1, vbDirectory) = "" Then MkDir dossier1 'crée le dossier s'il n'existe pas
        If Dir(dossier2, vbDirectory) = "" Then MkDir dossier2 'crée le dossier s'il n'existe pas
        If Dir(dossier3, vbDirectory) = "" Then fso.copyfolder dossier2, dossier3 'copie et crée le dossier une seule fois
    End If
Next
End Sub

Une fois créés la macro ne touche plus aux dossiers A B C etc.

 

[patricktoulon]

re
@job75 moi aussi il me semble sinon on aurait un problème
pour tester je l'ai lancé plusieurs fois

 

[job75]

Après création des dossiers A B C... bien voir que si on modifie les dossiers TYPE ces modifications ne seront pas répercutées sur les dossiers A B C etc.

 

[APPRENTI:)]

Avec ce dossier (3) et cette macro les dossiers TYPE sont copiés et A B C... créés une seule fois :

Sub Renommer_Transferer()
Dim fso As Object, chemin$, tablo, i&, dossier1$, dossier2$, dossier3
Set fso = CreateObject("Scripting.FileSystemObject")
chemin = ThisWorkbook.Path & "\"
tablo = Feuil1.UsedRange.Resize(, 3)
For i = 3 To UBound(tablo)
    If tablo(i, 1) <> "" And tablo(i, 3) <> "" Then
        dossier1 = chemin & UCase(tablo(i, 1))
        dossier2 = dossier1 & " TYPE"
        dossier3 = dossier1 & "\" & tablo(i, 3)
        If Dir(dossier1, vbDirectory) = "" Then MkDir dossier1 'crée le dossier s'il n'existe pas
        If Dir(dossier2, vbDirectory) = "" Then MkDir dossier2 'crée le dossier s'il n'existe pas
        If Dir(dossier3, vbDirectory) = "" Then fso.copyfolder dossier2, dossier3 'copie et crée le dossier une seule fois
    End If
Next
End Sub

Une fois créés la macro ne touche plus aux dossiers A B C etc.

Merci!!!! vous êtes des Pros!!

juste pour que je comprenne, à quoi correspond les dossiers 1, 2, 3?

 

[APPRENTI:)]

Après création des dossiers A B C... bien voir que si on modifie les dossiers TYPE ces modifications ne seront pas répercutées sur les dossiers A B C etc.

oui je comprends, les modifications s'opèreront sur les nouveaux dossiers. c'est parfait

 

[job75]

dossier1 => dossier de la colonne A

dossier2 => dossier TYPE correspondant

dossier3 => dossier A B C... de la colonne C

 

[APPRENTI:)]

Quelle efficacité!!

j'ai une dernière question.

Une fois les projets terminés, un bilan va être réalisé et je pense qu'il sera plus lisible de basculer la ligne vers l'onglet bilans répertoriant les bilans de tous les projets terminés.

Ce qui serait génial, c'est que le dossier du projet soit également déplacé dans un dossier BILAN répertoriant tous les projets terminés.

est-ce qu'il faut passer aussi par une macro qui ferait les 2 opérations en même temps?

Est ce que cela fait l'objet d'un autre sujet?

merci beaucoup à vous de faire partager votre savoir!!!

 

[job75]

Oui il vaudrait mieux créer une nouvelle discussion avec des explications claires.

Car là c'est le flou artistique, je ne comprends pas grand-chose.

 

[APPRENTI:)]

Bonjour Job 75,

Ton code fonctionne très bien!!
j'ai essayé de décaler la colonne "Nom", mais apparemment ça pose un problème.
Que dois-je changer au code pour pouvoir placer la colonne nom à coté de la colonne désignation?

Très bon Week-end à tous!

 

[job75]

Bonsoir APPENTI,

Très curieux que vous ne sachiez pas car il suffit dans la macro de remplacer tablo(i, 3) par tablo(i, 2).

A+