Récupérer des données de plusieurs fichiers pour faire un tableau récapitulatif

[badaboum]

Bonjour á tous,
Je travaille sur Excel 2010 et je débute en VBA (je travaille essentiellement sur des macros déjà faite que je modifie si besoin). Mais la tous se complique je dois créer ma propre macro..
J'ai essayé depuis 2 semaines de le faire par moi même en regardant sur internet mais sans succès.

Je vous explique, je vais récupérer chaque trimestre plusieurs fichiers de même forme ou je devrais récupérer les informations importantes sur plusieurs onglets pour les coller en valeurs dans un tableau récapitulatif commençant par le nom du fichier puis toutes les infos..

Le but serais de créer une macro qui va chercher les informations dans tous les fichiers que je reçois présents dans un dossier.

Je demande pas toute la macro, mais quelques pistes pour commencer car je suis complètement perdu..

Merci d'avance pour votre aide..

 

[Gareth]

Re : Récupérer des données de plusieurs fichiers pour faire un tableau récapitulatif

Bonjour et bienvenue,

Un petit fichier pour comprendre ce que tu veux faire ?....

 

[néné06]

Re : Récupérer des données de plusieurs fichiers pour faire un tableau récapitulatif

Bonjour Badaboum, salut Gareth,

Voici un petit exemple de récupération sur un fichier de tous les fichier présent dans un dossier.
Placer les fichiers dans un dossier et lancer la routine.
Regardes le code VBA et modifie le à ta guise.
J'espère que cela te donneras une piste ?

A+

René

 

[badaboum]

Re : Récupérer des données de plusieurs fichiers pour faire un tableau récapitulatif

Merci bcp, je vais essayer de commencer avec ça.
Je vous joint un Fichier vierge d'informations mais avec la forme du fichier que je reçois avec 3 onglets différents et en rouge c'est les cellules que je dois copier et coller dans un tableau récapitulatif (autre fichier joint "tracker"). Une ligne pour chaque fichier.

Merci pour votre aide.
Alex

 

[badaboum]

Re : Récupérer des données de plusieurs fichiers pour faire un tableau récapitulatif

Salut a tous,
J'ai essayé une ébauche de macro mais j'ai une erreur "RunTime error 1004", la macro ne trouve pas le dossier ou le fichier et je vois pas ou je me suis trompé..

Ci dessous la début de macro que j'ai "bricolé", pardon aceux que ca choquera
"
Sub test()
Dim Chemin As String, Fichier As String
Chemin = "D:\Internship CSD Pricing Docs\FOC essaie"
Fichier = Dir(Chemin & "*.xls")
i = 1
Set fso = New Scripting.FileSystemObject
Set DossierSource = fso.GetFolder(Chemin)

For Each F In DossierSource.Files
fbis = Mid(F, 10, Len(F) - 9)
Workbooks.Open Chemin & fbis
Workbooks(fbis).Activate

'Workbooks(fbis).Sheets(1).Range("G22" ).Copy (Workbooks("FOC_Credit Note Tracker.xlsm" ).Sheets("Cover" ).Cells(i, 1))
Workbooks("FOC_Credit Note Tracker.xlsm").Sheets("Cover").Cells(i, 1) = Workbooks(fbis).Sheets(1).Range("G22").Value

'Workbooks(fbis).Sheets(1).Range("G17" ).Copy (Workbooks("FOC_Credit Note Tracker.xlsm" ).Sheets("Cover" ).Cells(i, 2))
Workbooks("FOC_Credit Note Tracker.xlsm").Sheets("Cover").Cells(i, 2) = Workbooks(fbis).Sheets(1).Range("G17").Value

'Workbooks(fbis).Sheets(1).Range("G18" ).Copy (Workbooks("FOC_Credit Note Tracker.xlsm" ).Sheets("Cover" ).Cells(i, 4))
Workbooks("FOC_Credit Note Tracker.xlsm").Sheets("Cover").Cells(i, 4) = Workbooks(fbis).Sheets(1).Range("G18").Value

'Workbooks(fbis).Sheets(1).Range("C1" ).Copy (Workbooks("FOC_Credit Note Tracker.xlsm" ).Sheets("Summary" ).Cells(i, 5))
Workbooks("FOC_Credit Note Tracker.xlsm").Sheets("Summary").Cells(i, 5) = Workbooks(fbis).Sheets(1).Range("C1").Value

'Workbooks(fbis).Sheets(1).Range("D6" ).Copy (Workbooks("FOC_Credit Note Tracker.xlsm" ).Sheets("Summary" ).Cells(i, 6))
Workbooks("FOC_Credit Note Tracker.xlsm").Sheets("Summary").Cells(i, 6) = Workbooks(fbis).Sheets(1).Range("D6").Value

'Workbooks(fbis).Sheets(1).Range("D8" ).Copy (Workbooks("FOC_Credit Note Tracker.xlsm" ).Sheets("Summary" ).Cells(i, 7))
Workbooks("FOC_Credit Note Tracker.xlsm").Sheets("Summary").Cells(i, 7) = Workbooks(fbis).Sheets(1).Range("D8").Value

'Workbooks(fbis).Sheets(1).Range("D9" ).Copy (Workbooks("FOC_Credit Note Tracker.xlsm" ).Sheets("Summary" ).Cells(i, 8))
Workbooks("FOC_Credit Note Tracker.xlsm").Sheets("Summary").Cells(i, 8) = Workbooks(fbis).Sheets(1).Range("D9").Value


Workbooks(fbis).Close
i = i + 1
Next

End Sub "





Merci d'avance pour votre aide.

 

[néné06]

Re : Récupérer des données de plusieurs fichiers pour faire un tableau récapitulatif

Bonjour Alex,

J'ai regardé tes pièces jointes nous aurions besoin de quelques explications.

J'essaye de résumer ?

Tu reçois dans un dossier, plusieurs fichiers Template ?
Ces fichiers ont des données que tu souhaites exporter dans le fichier Tracker ?

Nous avons besoin de savoir quelles données du fichier Template et pour chaque onglets, tu souhaites les exporter dans le fichier Tracker et à quel emplacement ?

Le mieux serait que tu nous places des données "bidons" dans chaque onglet du fichier Template et que tu nous indiques où vont-elles se placer dans le fichier Tracker.

J'ai donc regardé tes fichiers et je dois avouer que je ne saisi pas quoi transférer !

A te relire

René

 

[badaboum]

Re : Récupérer des données de plusieurs fichiers pour faire un tableau récapitulatif

Bonjour René,
Merci pour ta réponse.
C'est exactement ca je recois pleins de fichiers template differents avec des donnees a exporter dans le fichier tracker.
Je mets en pieces les 2 fichiers. J ai mis en reouge les cellules a exporter avec des donnes bidons et a cote la colonne du tableau "tracker" ou doit aller la donnee.

Juste un début de code pour m’éclairer car je t'avoue que je bloque depuis 10 jours.

Merci bcp vraiment

 

[néné06]

Re : Récupérer des données de plusieurs fichiers pour faire un tableau récapitulatif

Re,

Rien que en regardant les fichiers et sans les ouvrir, je m'aperçois que tu est dans l'erreur.

Le fichier "Maitre" va être "Tracker", donc c'est sur ce fichier que tu auras la macro, qui ouvrira, prendra les données et les copiera.
Tu as un fichier Tracker en ".Xlsx" donc impossible de placer une macro dedans .
Tu crées le fichier "Tracker" en ."Xls" ou ".Xlsm" pour pouvoir placer une macro.

Je regarde les fichiers et j'essaye de te proposer une solution, mais j'ai peu de temps.
D'autres participants prendront certainement le relai.

A+

René

 

[badaboum]

Re : Récupérer des données de plusieurs fichiers pour faire un tableau récapitulatif

Oui je me suis tromper j'ai joint le fichier sans la macro mais m'essaie que j'ai fait été bien en .xlsm pour pouvoir mettre la macro..

Merci de ton aide en tout cas
Alexandre

 

[néné06]

Re : Récupérer des données de plusieurs fichiers pour faire un tableau récapitulatif

Salut Alexandre,

Regardes cette mouture, a placer dans le dossier avec les fichiers Template !

A+

René

 

[badaboum]

Re : Récupérer des données de plusieurs fichiers pour faire un tableau récapitulatif

Salut René,
Merci bcp pour ton aide, ça á l'air de marcher ..
Sinon aurais tu un endroit ou je peux trouver un cours détaillé sur VBA, j'ai du mal á trouver qq chose de complet avec des étapes..
Merci encore pour ton aide.
A+
Alexandre

 

[néné06]

Re : Récupérer des données de plusieurs fichiers pour faire un tableau récapitulatif

Re,

J'aime bien le petit livre en format A5, Gris et Rouge "VBA pour Excel 2003" "Le Guide Complet chez "Micro application" de Céline Loos Sparfel

Ce livre est très bien pour avoir de bonne base en VBA.

A+

René

 

[ChTi160]

Re : Récupérer des données de plusieurs fichiers pour faire un tableau récapitulatif

Bonjour badaboum
Bonjour néné06
Bonjour le Fil
Bonjour le Forum

une adaptation du très bon travail de Néné06

Option Explicit
Option Base 1
Sub Bouton2_Cliquer()
Dim Fichier, Dossier_actif, Nom_Fichier
Dim Tab_Recup() As Variant
Dim x As Byte
Dim Ind As Byte
Dim Chemin As String
Dim num As Integer

Application.ScreenUpdating = False 'Evite sautillement d'ecran
Application.DisplayAlerts = False
Chemin = ActiveWorkbook.Path 'Donne le chemin du classeur actif

Set Dossier_actif = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin).Files 'dossier actif

For Each Fichier In Dossier_actif 'pour chaque fichier dans ce dossier

If Fichier.Name Like "*Template*" Then 'On vérifie que le nom des fichiers du dossier contiennent "Template"
x = x + 1 'on incremente la variable

ReDim Preserve Tab_Recup(36, x) 'on redimmensionne le tableau en ajoutant une colonne

Nom_Fichier = Fichier.Name 'on récupére le nom du fichier

Workbooks.Open Filename:=Chemin & "\" & Nom_Fichier ' ouvrir ce fichier

With Sheets("Cover") 'avec cette feuille
Tab_Recup(2, x) = .Cells(22, 7) 'on récupere les donnees
Tab_Recup(3, x) = .Cells(16, 7)
Tab_Recup(4, x) = .Cells(17, 7)
Tab_Recup(6, x) = .Cells(18, 7)

End With
With Sheets("Summary") 'avec cette feuille

Tab_Recup(1, x) = .Cells(1, 3) 'on récupere les donnees
Tab_Recup(7, x) = .Cells(6, 4)
Tab_Recup(8, x) = .Cells(8, 4)
Tab_Recup(9, x) = .Cells(9, 4)


For Ind = 1 To 12 'on boucle
Tab_Recup(9 + Ind, x) = .Cells(12 + Ind, 4) 'on récupere les donnees
Next Ind

For Ind = 1 To 3 'on boucle
Tab_Recup(33 + Ind, x) = .Cells(23, 7 + Ind) 'on récupere les donnees
Next Ind

End With
With Sheets("Item Details") 'avec cette feuille
For Ind = 1 To 12 'on boucle
Tab_Recup(21 + Ind, x) = .Cells(4, Ind) 'on récupere les donnees
Next Ind
End With
ActiveWorkbook.Close False 'fermer ce classeur
End If
Next 'suivant
Application.ScreenUpdating = True
With Sheets("Tracker")
num = .Cells.Find("*", , , , , xlPrevious).Row + 1 'On determine la ligne ou coller les donnees
.Range("A" & num).Resize(UBound(Tab_Recup, 2), UBound(Tab_Recup, 1)) = Application.Transpose(Tab_Recup) 'on colle le tableau en l'inversant
End With
Erase Tab_Recup
End Sub

Bonne fin de Journée
Amicalement
Jean Marie

 

[badaboum]

Re : Récupérer des données de plusieurs fichiers pour faire un tableau récapitulatif

Salut á tous, je reviens vers vous car je dois modifier certaines choses dans ma macro. En fait il peut y avoir plusieurs lignes dans l'onglet "items details" dans le fichier "essaie template" joint la dernière fois. Du coup, je dois si jai bien compris intégrer une boucle conditionnelle a l’intérieur de ma macro pour dire qu'elle recopie la ligne tant que c'est remplie...
Ma question est puis je intégrer cette boucle directement dans la macro précédente ou il faut complètement tout refaire?
Merci pour votre aide.
Alexandre

 

[badaboum]

Re : Récupérer des données de plusieurs fichiers pour faire un tableau récapitulatif

J'ai essayé de faire qq chose mais le code ne fait que tourner il beug sur le "end IF" apres le "exit do"
Voici mon code :

Sub Bouton2_Cliquer()
    Dim Fichier, Dossier_actif, Nom_Fichier
    Dim donne(50)
    Application.ScreenUpdating = False 'Evite sautillement d'ecran
    Application.DisplayAlerts = False
    Chemin = ActiveWorkbook.Path 'Donne le chemin du classeur actif
    Fichier_actif = ActiveWorkbook.Name 'Donne le nom du classeur actif
    Set Dossier_actif = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin).Files 'dossier actif
        For Each Fichier In Dossier_actif 'pour chaque fichier dans ce dossier
            Nom_Fichier = Fichier.Name 'mémorise les noms des fichiers du dossier un après l'autre
            b = Right(Nom_Fichier, 4) 'b= extension du fichier (xlsm)
                If Left(Nom_Fichier, 1) <> "~" Then
                    If b = "xlsm" And Nom_Fichier <> ActiveWorkbook.Name Then 'Si extension= xls et ce fichier <> de "Recapitulatif" alors
                        Workbooks.Open Filename:=Chemin & "\" & Nom_Fichier ' ouvrir ce fichier
                        
                        Sheets("Item Details").Activate 'activer feuille "Item Details"
                        
                        Dim SheetName As String
                                        SheetName = ActiveSheet.Name
                                        Range("b4").Select
                                        rowc = 0
                                        Do While (ActiveCell.Value <> "-")
                                            If (ActiveCell.Value <> "-") Then
                                                 rowc = rowc + 1
                                                ActiveCell.Offset(1, 0).Select
                                            Else
                                                Exit Do
                                            End If
                                        Loop
                        
                        Sheets("Cover").Activate 'activer feuille "Cover"
                        donne(2) = Cells(22, 7)
                        donne(3) = Cells(16, 7)
                        donne(4) = Cells(17, 7)
                        donne(6) = Cells(18, 7)
                        Sheets("Summary").Activate 'activer feuille "Summary"
                        donne(1) = Cells(1, 3)
                        donne(7) = Cells(6, 4)
                        donne(8) = Cells(8, 4)
                        donne(9) = Cells(9, 4)
                        donne(10) = Cells(13, 4)
                        donne(11) = Cells(14, 4)
                        donne(12) = Cells(15, 4)
                        donne(13) = Cells(16, 4)
                        donne(14) = Cells(17, 4)
                        donne(15) = Cells(18, 4)
                        donne(16) = Cells(19, 4)
                        donne(17) = Cells(20, 4)
                        donne(18) = Cells(21, 4)
                        donne(19) = Cells(22, 4)
                        donne(20) = Cells(23, 4)
                        donne(21) = Cells(24, 4)
                        donne(34) = Cells(32, 9)
                        donne(35) = Cells(23, 9)
                        donne(36) = Cells(23, 10)
                        Sheets("Item Details").Activate 'activer feuille "Item Details"
                        donne(22) = Cells(4, 1)
                        donne(23) = Cells(4, 2)
                        donne(24) = Cells(4, 3)
                        donne(25) = Cells(4, 4)
                        donne(26) = Cells(4, 6) 'z
                        donne(27) = Cells(4, 8)
                        donne(28) = Cells(4, 10)
                        donne(29) = Cells(4, 12)
                        donne(30) = Cells(4, 13)
                        donne(31) = Cells(4, 16)
                        donne(32) = Cells(4, 17)
                        donne(33) = Cells(4, 20)
                        ActiveWorkbook.Close 'fermer ce classeur
                        Windows(Fichier_actif).Activate 'activer (Recapitulatif)
                        Sheets("Tracker").Activate ' activer feuille
                        num = Cells.Find("*", , , , , xlPrevious).Row 'recherche de la derniere ligne ecrite
                            For i = 1 To 36
                                Cells(num + 1, i) = donne(i)
                            Next i
                    End If
                End If
        Next 'suivant
End Sub

Merci d'avance pour votre aide.
alex