Regrouper données de plusieurs fichiers dans un tableau synthèse

Bonjour,

Je viens vers vous suite à plusieurs recherche sur le même sujet mais je ne parviens pas à faire ce que je veux avec mes capacités en VBA.

Je possède deux types de fichiers :

  • Un fichier Récapitulatif
  • Plusieurs fichier « formulaire » qui seront créer chaque semaine manuellement dans un dossier.
Je souhaiterais regrouper l’ensemble de mes formulaires de même formes (identique) dans un seul classeur Excel déjà crée : fichier synthèse.

J’ai trouvé sur internet qui me semble juste à retravaillé, mais je me retrouve avec des erreurs… (https://msdn.microsoft.com/fr-fr/library/office/gg549168(v=office.14).aspx)

En repartant de la même base que le code ci-dessus, je souhaiterais lancer la macro depuis le fichier synthèse :

- Modifier le mode de sélection de fichier, je voudrais pouvoir sélectionner les fichiers (formulaire) manuellement. Pouvoir sélectionner plusieurs fichiers de divers dossiers

' Modify this folder path to point to the files you want to use.

FolderPath = ThisWorkbook.Path & "\"

‘Cette fonction permet uniquement de prendre les fichiers d’un même dossier ?

- Copier, pour l’ensemble des formulaires les plages de données (« B16 :K25 ») et les coller les une à la suite des autres dans le fichier récapitulatif en colonne C2.

- Ajouter sur la gauche en colonne B, le nom d’import des fichiers

- Copier les cellules « I5:L13 » dans le fichier récapitulatif (en transposer) en colonne V:AD (voir fichier récap), avec les cellules « Semaine, « Entreprise », « Application », « Nombre de probleme », « nombre résolu ».

Ajouter à ce tableau, la somme de l’ensemble des colonnes.

- Copie des cellules Besoins et Amélioration F27 et F33 et copie dans le fichier récapitulatif dans les colonnes AI et AJ

J’espère que mes explications sont parlante, sinon, je peux vous réexpliquer,

Je vous remercie pour votre aide, et votre temps,

Joe

21recapitulatif.xlsm (23.29 Ko)

Je vous joint une nouvelle version du fichier récapitulatif avec la partie Graphique, permettant de comprendre un peu mieux le fonctionnement.

- Connaissez-vous un moyen (formule, fonction) pour pouvoir sélectionner plusieurs fichiers dans divers dossier ?

Je vous remercie,

11recapitulatif.xlsm (51.13 Ko)

Bonjour Joe, bonjour le forum,

Une proposition avec le code ci-dessous :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim K As Integer 'déclare la variable K (incrément)
Dim NF As Byte 'déclare la variable NF (Nombre de Fichiers)
Dim TC() As Workbook 'déclare la variable TC (Tableau des Classeurs)
Dim CL As Integer 'déclare la variable CL (CLasseur)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DEST1 As Range 'déclare la variable DEST1 (cellule de DESTination 1)
Dim DEST2 As Range 'déclare la variable DEST2 (cellule de DESTination 2)
Dim LI As Integer 'déclare la variable LI (LIgne)
Dim COL As Byte 'déclare la variable COL (COLonne)

Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("Données") 'définit l'onglet destination OD
OD.Range("B2:AE" & Application.Rows.Count).ClearContents 'efface d'éventuelles ancienne données

'***********************************************************************************************
'cette partie permet de sélectionner et d'ouvrir tous les fichiers (un ou plusieurs par dossier)
'***********************************************************************************************
K = 0 'initialise la variable K
deb: 'étiquette
With Application.FileDialog(msoFileDialogOpen) 'prend en compte la boîte de dialogue ouverture de fichier
    .AllowMultiSelect = True 'autorise la sélection multiple
    .Show 'affiche la boîte
    For NF = 1 To .SelectedItems.Count 'boucle sur le nombre de fichiers NF sélectionnés dans la boîte de dialogue
        ReDim Preserve TC(K) 'redimensionne de tableau des classeurs TC
        Workbooks.Open (.SelectedItems(NF)) 'ouvre le classeur de la boucle
        Set TC(K) = ActiveWorkbook 'définit le classeur indexé K du tableau des classeurs
        K = K + 1 'incrémente K
    Next NF 'prochain fichier de la boucle
End With 'fin de la prise en compte de la boîte de dialogue ouverture de fichier
If MsgBox("Voulez-vous ouvrir d'autres fichiers ?", vbYesNo, "OUVERTURE") = vbYes Then GoTo deb 'si "Oui" au message va à l'étiquette "deb" (re ouvre la bôite de dialogue d'ouverture de fichiers)

If K = 0 Then Exit Sub 'si aucun fichier ouvert, sort de la procédure

'************************************************************************************
'cette partie récupere les données des fichiers source puis ferme ces fichiers source
'************************************************************************************
For CL = 0 To UBound(TC) 'boucle sur tous les classeurs CL du tableau des classeurs
    Set CS = TC(CL) 'définit le classeur source CS
    Set OS = CS.Worksheets("Feuil1") 'définit l'onglet source OS
    'définit la cellule de destination DEST1 (C2 si C2 est vide, sinon, la première cellule vide de la colonne C de l'onglet OD)
    If OD.Range("C2") = "" Then Set DEST1 = OD.Range("C2") Else Set DEST1 = OD.Cells(Application.Rows.Count, "C").End(xlUp).Offset(1, 0)
    DEST1.Resize(10, 10).Value = OS.Range("B16:K25").Value 'récupère les données de la plage B16:K25
    DEST1.Offset(0, -1).Value = CS.Name 'récupère le nom du classeur source
    Set DEST2 = OD.Cells(Application.Rows.Count, "R").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST2 (première cellule vide de la colonne R de l'onglet OD)
    DEST2.Value = OS.Range("G7:G8").Value 'récupère les données source
    DEST2.Offset(0, 1).Value = OS.Range("F7:F8").Value 'récupère les données source
    DEST2.Offset(0, 2).Value = OS.Range("G9").Value 'récupère les données source
    DEST2.Offset(0, 3).Value = OS.Range("G10").Value 'récupère les données source
    DEST2.Offset(0, 4).Value = OS.Range("G11").Value 'récupère les données source
    DEST2.Offset(0, 5).Resize(1, 9).Value = Application.Transpose(OS.Range("L5:L13").Value) 'récupère les données source
    CS.Close False 'ferme le classeur source sans enregistrer
Next CL 'prochain classeur de la boucle

'******
'totaux
'******
LI = OD.Cells(Application.Rows.Count, "U").End(xlUp).Offset(2, 0).Row 'définit la ligne LI (ligne de la seconde cellule vide de la colonne U de l'onglet OD)
For COL = 21 To 31 'boucle sur les colonne 21 à 31 (=> aux colonnes U à AE)
    OD.Cells(LI, COL).Value = Application.WorksheetFunction.Sum(OD.Range(OD.Cells(2, COL), OD.Cells(LI - 2, COL))) 'renvoie le calcul ds totaux
Next COL 'prochaine colonne de la boucle
Application.ScreenUpdating = True 'affiche les raffraîchissements d'écran
End Sub

Le fichier :

40recapitulatif.xlsm (35.65 Ko)

Bonjour Joe, bonjour le forum,

Une proposition avec le code ci-dessous :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim K As Integer 'déclare la variable K (incrément)
Dim NF As Byte 'déclare la variable NF (Nombre de Fichiers)
Dim TC() As Workbook 'déclare la variable TC (Tableau des Classeurs)
Dim CL As Integer 'déclare la variable CL (CLasseur)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DEST1 As Range 'déclare la variable DEST1 (cellule de DESTination 1)
Dim DEST2 As Range 'déclare la variable DEST2 (cellule de DESTination 2)
Dim LI As Integer 'déclare la variable LI (LIgne)
Dim COL As Byte 'déclare la variable COL (COLonne)

Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("Données") 'définit l'onglet destination OD
OD.Range("B2:AE" & Application.Rows.Count).ClearContents 'efface d'éventuelles ancienne données

'***********************************************************************************************
'cette partie permet de sélectionner et d'ouvrir tous les fichiers (un ou plusieurs par dossier)
'***********************************************************************************************
K = 0 'initialise la variable K
deb: 'étiquette
With Application.FileDialog(msoFileDialogOpen) 'prend en compte la boîte de dialogue ouverture de fichier
    .AllowMultiSelect = True 'autorise la sélection multiple
    .Show 'affiche la boîte
    For NF = 1 To .SelectedItems.Count 'boucle sur le nombre de fichiers NF sélectionnés dans la boîte de dialogue
        ReDim Preserve TC(K) 'redimensionne de tableau des classeurs TC
        Workbooks.Open (.SelectedItems(NF)) 'ouvre le classeur de la boucle
        Set TC(K) = ActiveWorkbook 'définit le classeur indexé K du tableau des classeurs
        K = K + 1 'incrémente K
    Next NF 'prochain fichier de la boucle
End With 'fin de la prise en compte de la boîte de dialogue ouverture de fichier
If MsgBox("Voulez-vous ouvrir d'autres fichiers ?", vbYesNo, "OUVERTURE") = vbYes Then GoTo deb 'si "Oui" au message va à l'étiquette "deb" (re ouvre la bôite de dialogue d'ouverture de fichiers)

If K = 0 Then Exit Sub 'si aucun fichier ouvert, sort de la procédure

'************************************************************************************
'cette partie récupere les données des fichiers source puis ferme ces fichiers source
'************************************************************************************
For CL = 0 To UBound(TC) 'boucle sur tous les classeurs CL du tableau des classeurs
    Set CS = TC(CL) 'définit le classeur source CS
    Set OS = CS.Worksheets("Feuil1") 'définit l'onglet source OS
    'définit la cellule de destination DEST1 (C2 si C2 est vide, sinon, la première cellule vide de la colonne C de l'onglet OD)
    If OD.Range("C2") = "" Then Set DEST1 = OD.Range("C2") Else Set DEST1 = OD.Cells(Application.Rows.Count, "C").End(xlUp).Offset(1, 0)
    DEST1.Resize(10, 10).Value = OS.Range("B16:K25").Value 'récupère les données de la plage B16:K25
    DEST1.Offset(0, -1).Value = CS.Name 'récupère le nom du classeur source
    Set DEST2 = OD.Cells(Application.Rows.Count, "R").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST2 (première cellule vide de la colonne R de l'onglet OD)
    DEST2.Value = OS.Range("G7:G8").Value 'récupère les données source
    DEST2.Offset(0, 1).Value = OS.Range("F7:F8").Value 'récupère les données source
    DEST2.Offset(0, 2).Value = OS.Range("G9").Value 'récupère les données source
    DEST2.Offset(0, 3).Value = OS.Range("G10").Value 'récupère les données source
    DEST2.Offset(0, 4).Value = OS.Range("G11").Value 'récupère les données source
    DEST2.Offset(0, 5).Resize(1, 9).Value = Application.Transpose(OS.Range("L5:L13").Value) 'récupère les données source
    CS.Close False 'ferme le classeur source sans enregistrer
Next CL 'prochain classeur de la boucle

'******
'totaux
'******
LI = OD.Cells(Application.Rows.Count, "U").End(xlUp).Offset(2, 0).Row 'définit la ligne LI (ligne de la seconde cellule vide de la colonne U de l'onglet OD)
For COL = 21 To 31 'boucle sur les colonne 21 à 31 (=> aux colonnes U à AE)
    OD.Cells(LI, COL).Value = Application.WorksheetFunction.Sum(OD.Range(OD.Cells(2, COL), OD.Cells(LI - 2, COL))) 'renvoie le calcul ds totaux
Next COL 'prochaine colonne de la boucle
Application.ScreenUpdating = True 'affiche les raffraîchissements d'écran
End Sub

Le fichier :

Bonjour ThauThème,

je souhaiterais adapter ton code selon mes besoins mais n'arrive pas au bout du processus.

La partie permettant de sélectionner les fichiers sources me convient parfaitement, mais ensuite je souhaiterais fusionner (faire une somme des plages) les données sur le fichier de destination. Dans ton code tu colles les données de la première ligne de C (Set DEST1 = OD.Cells(Application.Rows.Count, "C").End(xlUp).Offset(1, 0)) mais je voudrais que toute la plage copiée (par OS sélectionné) soit collée au même endroit de l'OD. Dans mon cas tous les OS = E7:M14 et OD = E7:M14

pourrais-tu m'aider car je n'arrive pas à obtenir ce que je souhaite. J'espère que mon explication est claire.

Bonjour Badou, bonjour le forum,

Essaie comme ça :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim K As Integer 'déclare la variable K (incrément)
Dim NF As Byte 'déclare la variable NF (Nombre de Fichiers)
Dim TC() As Workbook 'déclare la variable TC (Tableau des Classeurs)
Dim CL As Integer 'déclare la variable CL (CLasseur)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CEL As Range 'déclare la variable CEL (CELlule)

Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("Données") 'définit l'onglet destination OD
OD.Range("E7:M14" & Application.Rows.Count).ClearContents 'efface d'éventuelles ancienne données

'***********************************************************************************************
'cette partie permet de sélectionner et d'ouvrir tous les fichiers (un ou plusieurs par dossier)
'***********************************************************************************************
K = 0 'initialise la variable K
deb: 'étiquette
With Application.FileDialog(msoFileDialogOpen) 'prend en compte la boîte de dialogue ouverture de fichier
    .AllowMultiSelect = True 'autorise la sélection multiple
    .Show 'affiche la boîte
    For NF = 1 To .SelectedItems.Count 'boucle sur le nombre de fichiers NF sélectionnés dans la boîte de dialogue
        ReDim Preserve TC(K) 'redimensionne de tableau des classeurs TC
        Workbooks.Open (.SelectedItems(NF)) 'ouvre le classeur de la boucle
        Set TC(K) = ActiveWorkbook 'définit le classeur indexé K du tableau des classeurs
        K = K + 1 'incrémente K
    Next NF 'prochain fichier de la boucle
End With 'fin de la prise en compte de la boîte de dialogue ouverture de fichier
If MsgBox("Voulez-vous ouvrir d'autres fichiers ?", vbYesNo, "OUVERTURE") = vbYes Then GoTo deb 'si "Oui" au message va à l'étiquette "deb" (re ouvre la bôite de dialogue d'ouverture de fichiers)

If K = 0 Then Exit Sub 'si aucun fichier ouvert, sort de la procédure

'************************************************************************************
'cette partie récupere les données des fichiers source puis ferme ces fichiers source
'************************************************************************************
For CL = 0 To UBound(TC) 'boucle sur tous les classeurs CL du tableau des classeurs
    Set CS = TC(CL) 'définit le classeur source CS
    Set OS = CS.Worksheets("Feuil1") 'définit l'onglet source OS
    For Each CEL In OD.Range("E7:M14")
        CEL.Value = CEL.Value + OS.Range(CEL.Address).Value
    Next CEL
    CS.Close False 'ferme le classeur source sans enregistrer
Next CL 'prochain classeur de la boucle
Application.ScreenUpdating = True 'affiche les raffraîchissements d'écran
End Sub

Magnifique! ça marche nickel. passe un agréable weekend

Rechercher des sujets similaires à "regrouper donnees fichiers tableau synthese"