Boucle transférer+ rassembler informations

Bonjour,

J'ai plusieurs fichiers dans un dossier représentant des fiches Excel.

Je voudrais dans un autre fichier Excel, chercher chacune des informations de ces fiches et les classer dans un seul et même tableau récapitulatif.

Ainsi, il faudrait une boucle qui ouvre chacun des fichiers et transfère les informations dans le tableau.

A noter : Les fiches et le tableau sont fixes, ainsi la position des cellules ne change pas.

ps: pour les deux fichiers des fiches, je n'ai pas entré de données

Fichier joint ci-dessous.

Merci d'avance pour votre aide chère amis.

Bonjour Aslo, bojour le forum,

aslo83 a écrit :

ps: pour les deux fichiers des fiches, je n'ai pas entré de données

Très mauvaise idée. Comment veux-tu qu'on teste !...

Essaie le code ci-dessous à compléter :

Sub Macro2()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OD (Onglet Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichier)
Dim LI As Integer 'déclare la variable LI (LIgne)

Set CD = ThisWorkbook 'définit le claseur destination CD
Set OD = CD.Worksheets("KPI's PVC") 'définit l'onglet destination OD
Set CA = ThisWorkbook.Path & "\compil_new\" 'définit le chemin d'accès CA
F = Dir(CA & "*.xlsx") 'définit le premier fichier .xlsx ayant CA comme chemin d'accès
Do While F <> "" 'boucle tant qu'il existe des fichers F
    Set CS = Workbooks.Open(CA & F) 'définit le classeur source CS (en l'ouvrant)
    Set OS = CS.Worksheets(1) 'définit l'onglet source (le premier onglet du classeur source)
    'définit la ligne LI (13 si A13 est vide, sinon la première ligne vide de la colonne A de l'onglet OD)
    LI = IIf(OD.Range("A13") = "", 13, OD.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1)
    'je ne sais pas à quoi correspond cette celluel j'ai incrémenté les numéros... Tu adapteras
    OD.Cells(LI, "A").Value = Application.WorksheetFunction.Max(OD.Columns(1)) + 1
    OD.Cells(LI, "B").Value = OS.Range("C4").Value 'récupère le [number]
    OD.Cells(LI, "C").Value = OS.Range("F4:G4").Value 'récupère la [date]
    OD.Cells(LI, "F").Value = OS.Range("B5:G5").Value 'récupère le [site]
    OD.Cells(LI, "G").Value = OS.Range("C6:G6").Value 'récupère le [matricule]
    OD.Cells(LI, "H").Value = OS.Range("B7:G7").Value 'récupère le [matricule]
    '... continuer jusqu'à
    OD.Cells(LI, "AA").Value = OS.Range("E37:E39").Value 'récupère le [Customer]
    OS.Close False 'feme le classeru source sans enregistrer
    F = Dir 'définit le prochain fichier .xlsx ayant CA comme chemin d'accès
Loop 'boucle
End Sub