Agrèger données de plusieurs classeurs avec VBA

[MADO]

Bonsoir les amis, i'm back !
J'aurais besoin de votre aide pour une macro, je ne maitrise pas VBA.
J'ai 5 dossiers :
- dossier 1 : 23 classeurs et 8 feuilles (formats et noms de feuilles identiques) ;
- dossier 2 : 23 classeurs et 11 feuilles (formats et noms de feuilles identiques) ;
- dossier 3 : 23 classeurs et 6 feuilles (formats et noms de feuilles identiques) ;
- dossier 4 : 23 classeurs et 6 feuilles (formats et noms de feuilles identiques) ;
- dossier 5 : 23 classeurs et 18 feuilles (formats et noms de feuilles identiques).

Objectif : Créer un dossier avec 5 classeurs et une macro qui :

- classeur 1 : agrège les données du dossier 1 suivant le même format et nombre de feuilles ;
- classeur 2 : agrège les données du dossier 2 suivant le même format nombre de feuilles;
- classeur 3 : agrège les données du dossier 2 suivant le même format nombre de feuilles;
- classeur 4 : agrège les données du dossier 4 suivant le même format nombre de feuilles ;
- classeur 5 : agrège les données du dossier 5 suivant le même format nombre de feuilles.

Je vous remercie d'avance et reste disponible pour d'éventuels compléments d'information.

 

[MADO]

Bonjour
Quelqu'un pour m'aider please ?

 

[Robert]

Bonsoir Mado, bonsoir le forum,

Ça manque de pas mal d' informations ! Essaie le code ci-dessous à adapter :

Sub Macro3()
Dim CO As Workbook 'décalre la variable CO (Classeur d'Origine)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim DS(1 To 5) As String 'déclare la variable DS (DossierS)
Dim D As Byte 'déclare la variable D (Dossier)
Dim NBO As Byte 'déclare la variable NBO (NomBre d'Onglets)
Dim CA As Workbook 'déclare la variable CA (Classeur Agrégation)
Dim F As String 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destnation)
Dim DEST As Range 'déclare la variable DEST (cellule de destination)

Set CO = ThisWorkbook 'définit la classeur d'Origine
CH = CO.Path & "\" 'définit le chemin d'accès CH
DS(1) = "C:\Users\Mado\blabla1\blabla2\dossier1\" 'définit la dossier DS(1) [à adapter !]
DS(2) = "C:\Users\Mado\blabla1\blabla2\dossier2\" 'définit la dossier DS(2) [à adapter !]
DS(3) = "C:\Users\Mado\blabla1\blabla2\dossier3\" 'définit la dossier DS(3) [à adapter !]
DS(4) = "C:\Users\Mado\blabla1\blabla2\dossier4\" 'définit la dossier DS(4) [à adapter !]
DS(5) = "C:\Users\Mado\blabla1\blabla2\dossier5\" 'définit la dossier DS(5) [à adapter !]
For D = 1 To 5 'boucle sur les 5 dossiers D
    Select Case D 'agit en fonction du dossier
        Case 1 'dossier 1
            NBO = 8 'définit le nombre d'onglets
            Application.SheetsInNewWorkbook = NBO 'définit le nombre d'onglets à la création d'un nouveau classeur
        Case 2 'dossier 2
            NBO = 11 'définit le nombre d'onglets
            Application.SheetsInNewWorkbook = NBO 'définit le nombre d'onglets à la création d'un nouveau classeur
        Case 3, 4 'dossiers 3 et 4
            NBO = 6 'définit le nombre d'onglets
            Application.SheetsInNewWorkbook = NBO 'définit le nombre d'onglets à la création d'un nouveau classeur
        Case 5 'dossier 5
            NBO = 18 'définit le nombre d'onglets
            Application.SheetsInNewWorkbook = NBO 'définit le nombre d'onglets à la création d'un nouveau classeur
    End Select 'fin de l'action en fonction du dossier
    Workbooks.Add 'ajoute un mouveau classeur vierge
    'enregistre le nouveau classeur dans le même dossier que le classeur d'origine CO avec
    'comme nom ""Agreg_Dossier_D.xls"  ou "D" est le numéro de dossier de la boucle [extension à adapter !]
    ActiveWorkbook.SaveAs (CH & "Agreg_Dossier_" & D & ".xls")
    Set CA = ActiveWorkbook 'définit le classer des agrégations CA
    F = Dir(DS(D) & "*.xls") 'définit le premier fichier du dossier DS(D) [extension a adapter !]
    Do While F <> "" 'exécute en boucle tant qu'il existe des fichiers
        Workbooks.Open (DS(D) & F) 'ouvre le fichier
        Set CS = ActiveWorkbook 'définit le classeur source CS
        For O = 1 To NBO 'boucle 2 : sur tous les onglets O
            Set OS = CS.Sheets(O) 'définit l'onglet source OS du classeur source CS
            Set OD = CA.Sheets(O) 'définit l'onglet destination OD du classeur des agrégations CA
            'définit la cellule de destination DEST (A1 si A1 est vide , sinon la première cellule vide de la colonne A de l'onglet OD)
            Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Range("A" & Application.Rows.Count).End(xlUp).Offset(1, 0))
            OS.UsedRange.Copy DEST 'copie la plage éditée de l'onglet source dans la cellule A1 de l'onglet destination
        Next O 'prochain onglet de la boucle 2
        F = Dir 'définit le prochain fichier du dossier DS(D)
    Loop 'boucle
    CA.Close True 'ferme le classeur des agrégation en enregistant les modification
Next D 'prochain dossier D de la boucle 1
CO.Close False 'ferme le classeur d'origine sans enregistrer
Application.SheetsInNewWorkbook = 3 'réinitialise le nombre d'onglet à la création d'un nouveau classeur (3 par défaut mais à adapter)
End Sub

Il faut le mettre dans un classeur indépendant, en dehors des 5 dossiers de travail. Les fichiers agrégés seront crées dans le même dossier que ce classeur indépendant...

 

[MADO]

Bonsoir Robert
Merci d'avoir répondu à ma requête.
J'ai copié le code et essayé de l'adapter mais j'ai un problème au niveau de la partie où le fichier Agreg_Dossier_D doit être crée, notamment (ActiveWorkbook.SaveAs (CH & "Agreg_Dossier_" & D & ".XLSX")
Quand j'exécute la macro, y a un débogage à ce niveau.
Si tu peux m'éclairer un peu par rapport au commentaire relatif à ton commentaire après le code.
Je dois créer un dossier (Agreg_Dossier_D) et le fichier contenant la macro doit être enregistré là-bas ?
Merci de votre réactivité.

 

[Robert]

Bonsoir Mado, bonsoir le forum,

Le problème avec ton problème c'est que pour tester il fallait recréer tes conditions et comme tu n'as pas donné toutes les précisions nécessaires j'ai eu la flemme en pensant que toi tu le ferais. Mais comme ça na visiblement pas fonctionné, voilà ce que j'ai fait :
• j'ai créé un dossier que j'ai nommé Agreg
• dans un fichier vierge j'ai copié dans un module standard le code que je t'avais proposé puis j'ai enregistré ce fichier dans ce dossier Agreg avec comme nom Classeur Origine.xlsm.
• J'ai créé 5 dossiers avec chacun 3 fichiers (chez toi c'est 23 mais 3 étaient suffisants pour l'exemple) avec, selon le dossier, le nombre d'onglets indiqué.
• J'ai adapté la macro pour que les variables DS(1) à DS(5) correspondent au chemin d'accès de chaque dossier et modifié l'extension en remplaçant xls par xlsx...

• J'ouvre Excel
• j'ouvre le fichier Classeur Origine.xlsm.
• je lance la procédure Macro3
• Après un certain temps, correspondant à l'exécution de la macro, tous les fichiers Excel se ferment.
• Par l'explorateur de fichiers je retourne dans le dossier Agreg et il y a désormais, en plus du fichier Classeur Origine.xlsm, 5 fichiers nommé Agreg_Dossier_1.xlsx à Agreg_Dossier_5.xlsx contenant chacun les données des 3 (23 chez toi) fichiers de chaque dossier.
Donc maintenant j'ai testé et je peux te dire que ça marche !...
J'ai juste une peu retouché le code et voici la dernière mouture :

Sub Macro3()
Dim CO As Workbook 'décalre la variable CO (Classeur d'Origine)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim DS(1 To 5) As String 'déclare la variable DS (DossierS)
Dim D As Byte 'déclare la variable D (Dossier)
Dim NBO As Byte 'déclare la variable NBO (NomBre d'Onglets)
Dim CA As Workbook 'déclare la variable CA (Classeur Agrégation)
Dim F As String 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DEST As Range 'déclare la variable DEST (cellule de destination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CO = ThisWorkbook 'définit la classeur d'Origine
CH = CO.Path & "\" 'définit le chemin d'accès CH
DS(1) = "C:\Users\Mado\Blabla1\Blabla2\Dossier1\" 'définit la dossier DS(1) [à adapter !]
DS(2) = "C:\Users\Mado\Blabla1\Blabla2\Dossier2\" 'définit la dossier DS(2) [à adapter !]
DS(3) = "C:\Users\Mado\Blabla1\Blabla2\Dossier3\" 'définit la dossier DS(3) [à adapter !]
DS(4) = "C:\Users\Mado\Blabla1\Blabla2\Dossier4\" 'définit la dossier DS(4) [à adapter !]
DS(5) = "C:\Users\Mado\Blabla1\Blabla2\Dossier5\" 'définit la dossier DS(5) [à adapter !]
For D = 1 To 5 'boucle sur les 5 dossiers D
    Select Case D 'agit en fonction du dossier
        Case 1 'dossier 1
            NBO = 8 'définit le nombre d'onglets
            Application.SheetsInNewWorkbook = NBO 'définit le nombre d'onglets à la création d'un nouveau classeur
        Case 2 'dossier 2
            NBO = 11 'définit le nombre d'onglets
            Application.SheetsInNewWorkbook = NBO 'définit le nombre d'onglets à la création d'un nouveau classeur
        Case 3, 4 'dossiers 3 et 4
            NBO = 6 'définit le nombre d'onglets
            Application.SheetsInNewWorkbook = NBO 'définit le nombre d'onglets à la création d'un nouveau classeur
        Case 5 'dossier 5
            NBO = 18 'définit le nombre d'onglets
            Application.SheetsInNewWorkbook = NBO 'définit le nombre d'onglets à la création d'un nouveau classeur
    End Select 'fin de l'action en fonction du dossier
    Workbooks.Add 'ajoute un nouveau classeur vierge
    'enregistre le nouveau classeur dans le même dossier que le classeur d'origine CO avec
    'comme nom ""Agreg_Dossier_D.xls"  ou "D" est le numéro de dossier de la boucle [extension à adapter !]
    ActiveWorkbook.SaveAs (CH & "Agreg_Dossier_" & D & ".xlsx")
    Set CA = ActiveWorkbook 'définit le classer des agrégations CA
    F = Dir(DS(D) & "*.xlsx") 'définit le premier fichier du dossier DS(D) [extension a adapter !]
    Do While F <> "" 'exécute en boucle tant qu'il existe des fichiers
        Workbooks.Open (DS(D) & F) 'ouvre le fichier
        Set CS = ActiveWorkbook 'définit le classeur source CS
        For O = 1 To NBO 'boucle 2 : sur tous les onglets O
            Set OS = CS.Sheets(O) 'définit l'onglet source OS du classeur source CS
            Set OD = CA.Sheets(O) 'définit l'onglet destination OD du classeur des agrégations CA
            'définit la cellule de destination DEST (A1 si A1 est vide , sinon la première cellule vide de la colonne A de l'onglet OD)
            Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Range("A" & Application.Rows.Count).End(xlUp).Offset(1, 0))
            OS.UsedRange.Copy DEST 'copie la plage éditée de l'onglet source dans la cellule A1 de l'onglet destination
        Next O 'prochain onglet de la boucle 2
        CS.Close False 'ferme le classeur source CS sans enregistrer les modifications
        F = Dir 'définit le prochain fichier du dossier DS(D)
    Loop 'boucle
    CA.Close True 'ferme le classeur des agrégation en enregistrant les modifications
Next D 'prochain dossier D de la boucle 1
CO.Close False 'ferme le classeur d'origine sans enregistrer
Application.SheetsInNewWorkbook = 3 'réinitialise le nombre d'onglet à la création d'un nouveau classeur (3 par défaut mais à adapter)
Application.ScreenUpdating = tru 'affiche les rafraîchissements d'écran
End Sub

Donc si tu respectes les consignes ça devrait aussi marcher chez toi...

 

[MADO]

Bonjour Robert
Merci beaucoup d'avoir pris le temps de créer la macro pour moi.
J'ai fais la procédure comme décrite plus haut mais il y a un débogage à ce niveau
F = Dir(DS(D) & "*.xlsx") et vu que je ne maîtrise pas VBA, je ne peux pas trouver où ça bug.
Désolée de te fatiguer.
Bonne journée à toi !

 

[Robert]

Bonsoir Mado, bonsoir le forum,

Tu as bien adapté les chemins d'accès DS(1) à DS(5) ? Envoie au moins le code que tu as adapté...

 

[MADO]

Bonsoir Robert je suis entrain de constituer les dossier pour pouvoir les poster pour une meilleure visibilité.
Dans quelques minutes please.

 

[MADO]

Bonsoir Robert
Ci-joint, les 5 dossiers ainsi que celui contenant le fichier avec la macro.
Merci beaucoup pour ta patience.

 

[Robert]

Bonjour Mado, bonjour le forum,

Je n'avais pas besoin de tout ça. Comme dit plus haut, je l'avais déjà recréer sur ma machine. Seul le code m'intéressait. Principalement les 5 variables DS(1) à DS(5). Dans le fichier que tu m'envoies elle sont complètement erronées :

DS(1) = "'/Users/Name/Desktop/Dossier1/" 'dŽfinit la dossier DS(1) [ˆ adapter !]
DS(2) = "'/Users/Nameg/Desktop/Dossier2/" 'dŽfinit la dossier DS(2) [ˆ adapter !]
DS(3) = "'/Users/Name/Desktop/Dossier3/" 'dŽfinit la dossier DS(3) [ˆ adapter !]
DS(4) = "'/Users/Name/Desktop/Dossier4/" 'dŽfinit la dossier DS(4) [ˆ adapter !]
DS(5) = "'/Users/Name/Desktop/Dossier5/" 'dŽfinit la dossier DS(5) [ˆ adapter !]

• Il n'y a pas de disque (C, D, ou E ou etc.) suivit de :\
• Tu as utilisé le slash "/" à la place de l'anti-slash "\"
• La seconde est dans le dossier Nameg au lieu de Name...
Ton problème vient de là. Dans ces variables, il faut le chemin d'accès complet au 5 dossiers correctement écrit.
Fait un effort on évitera de perdre du temps !...

 

[MADO]

Bonjour Robert
J’espère que je ne te fatigue pas trop, désolée.
Je travaillais sur mon Macbook durant le week end.
Aujourd'hui je suis au bureau et j'ai adapté le code et le chemin d’accès est bon avec le "D:\Users\Mado\Blabla1\Blabla2\Dossier1\".
Toutefois, ça bug au niveau du F = Dir(DS(D) & "*.xlsx"). Peut-être que les noms des fichiers doivent être libellés d'une certaine façon que je ne connais pas ?
Je suis vraiment désolée.

 

[Robert]

Re,

Arf Mado ! Je vais te donner l'adresse d'un excellent salon de coiffure qui décolore une blonde en brune en moins de temps qu'il ne m'en faut pour dire une co***erie...
"D:\Users\Mado\Blabla1\Blabla2\Dossier1\" était juste un exemple bidon pour te faire comprendre, enfin du moins essayer, qu'il fallait l'adapter à ton cas !... D'ailleurs c'était écrit juste après...
Quels sont les vrais chemins d'accès de tes dossiers P** de B*** de M*** ???! (Purée de Banane de Madagascar ça va de soi !...).
Non tu ne me fatigues pas ! Mais là, un supp effervescent et au lit...

 

[MADO]

Hahaha
Ne t’inquiète pas Robert, j'ai bien mis le bon chemin, j'ai pas mis les blabla,Mado et tout ça lol.

DS(1) = "'D:\Public\SAP\STAT\Dossier1\" 'définit la dossier DS(1) [à adapter !]
DS(2) = "'D:\Public\SAP\STAT\Dossier2\" 'définit la dossier DS(2) [à adapter !]
DS(3) = "'D:\Public\SAP\STAT\Dossier3\" 'définit la dossier DS(3) [à adapter !]
DS(4) = "'D:\Public\SAP\STAT\Dossier4\" 'définit la dossier DS(4) [à adapter !]
DS(5) = "'D:\Public\SAP\STAT\Dossier5\" 'définit la dossier DS(5) [à adapter !]

 

[Robert]

Re,

Il y a une apostrophe en trop avant !... Le code correct :

DS(1) = "D:\Public\SAP\STAT\Dossier1\" 
DS(2) = "D:\Public\SAP\STAT\Dossier2\"
DS(3) = "D:\Public\SAP\STAT\Dossier3\"
DS(4) = "D:\Public\SAP\STAT\Dossier4\"
DS(5) = "D:\Public\SAP\STAT\Dossier5\"

[Édition]
Pardon Mado pour mon post précédent un peu méchant. Je vois que je suis tombé sur quelqu'un qui a de l'humour et ça c'est assez rare pour t'en féliciter et te présenter mes excuses...

 

[MADO]

Re :
T’inquiète Robert !
Je te comprends très bien et je te remercie encore pour ta patience lol.
J'ai pu exécuter la macro mais les données sont disposées les unes en dessous des autres, alors que j'ai besoin d'une somme par cellule sur un autre fichier pour les 23 classeurs de chaque dossier.