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

APPRENTI:) · 1 Avril 2020

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 · 1 Avril 2020

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

VB:

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...

job75 · 1 Avril 2020

APPRENTI:) à dit:
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 · 1 Avril 2020

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

VB:

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 · 1 Avril 2020

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

VB:

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 · 1 Avril 2020

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

job75 · 1 Avril 2020

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:) · 1 Avril 2020

job75 à dit:

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

VB:

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:) · 1 Avril 2020

job75 à dit:
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 · 1 Avril 2020

dossier1 => dossier de la colonne A

dossier2 => dossier TYPE correspondant

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

APPRENTI:) · 1 Avril 2020

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 · 1 Avril 2020

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:) · 29 Mai 2020

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 · 29 Mai 2020

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+

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

APPRENTI:)

XLDnaute Nouveau

Pièces jointes

job75

job75

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

APPRENTI:)

XLDnaute Nouveau

APPRENTI:)

XLDnaute Nouveau

job75

XLDnaute Barbatruc

APPRENTI:)

XLDnaute Nouveau

job75

XLDnaute Barbatruc

APPRENTI:)

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

Discussions similaires