Extraction de données de feuilles plusieurs classeurs pour une synthèse

Bonjour,

Je cherche à récupérer les données de produits différents ayant un classeur chacun, ces données sont réparties sur 2 feuilles par classeur. Je voudrais récupérer ces données afin de faire une synthèse de chacune des deux types de feuilles.

Pour être plus clair si je ne le sui spas assez, chaque produit à des données A et B, je cherche à faire une synthèse des A sur une feuille et des B sur une seconde feuille et celles ci dans le même classeur.

Pour ce faire j'ai d'abord cherché sur plusieurs forum et une certaines réponse de ThauThème à attirer mon attention mais je n'arrive pas à la modifier pour la faire fonctionner pour mon cas.

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 CA As String 'déclare la variable CA (Chemin d'Accès)

Dim F As String 'déclare la variable F (Fichiers)

Dim CS As Workbook 'déclare la variable CS (Classeur Source)

Dim OS As Worksheet 'déclare la variable OS (Onglet Source)

Dim DL As Long 'déclare la variable DL (Dernière Ligne)

Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran

Set CD = ThisWorkbook 'définit le classeur destination CD

Set OD = CD.Sheets("FFT") 'définit l'onglet destination OD

CA = CD.Path '& "C:\Users\FX606712\Desktop\Test" 'définit le chemin d'accès CA

OD.Range("A4:AH" & Application.Rows.Count).Clear 'supprime d'éventuelles ancienne données dans l'onglet OD

F = Dir(CA & "*.xlsx") 'définit le premier fichier F avec l'extension ".xlsx" dans le dossier CA

Do While F <> "" 'exécute tant qu'il existe des fichiers F

'si les 8 premiers caractères (convertis en entier long) du nom di fichier F sont supérieur à DM, DM devient cet entier long

'If CLng(Left(F, 8)) > DR Then DM = CLng(Left(F, 8))

F = Dir 'fichier suivant, avec l'extension ".xlsx" dans le dossier CA

Loop 'boucle

F = Dir(CA & CStr(Synthèse) & "*.xlsx") 'définit le premier fichier F commençant par Synthèse, avec l'extension ".xlsx" dans le dossier CA

Do While F <> "" 'exécute tant qu'il existe des fichiers F

Application.Workbooks.Open (F) 'ouvre le fichier F

Set CS = ActiveWorkbook 'définit le classeur source CS

Set OS = CS.Sheets("SYNTHESE FFT") 'définit l'onglet source OS

'définit la cellule de destination DEST (A4, si A4 est vide, sinon, la première cellule vide de la colonne A de l'onglet OD)

Set DEST = IIf(OD.Range("A3").Value = "", OD.Range("A3"), OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0))

DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'dédinit la dernière ligne éditée de la colonne A de l'onglet OS

OS.Range("A4:AG" & DL).Copy 'copie la plage A5:AG...(DL)

DEST.PasteSpecial (xlPasteValuesAndNumberFormats) 'renvoie dans DEST les valeurs et les formats de nombre de la plage copiée

DEST.Offset(0, 33).Value = OS.Range("a1").Value 'récupère le nom de 'longlet source

CS.Close SaveChanges = False 'ferme le fichier source sans enregister les changements

F = Dir 'fichier suivant commençant par DM avec l'extension ".xlsx" dans le dossier CA

Loop 'boucle

OD.Range("A3").Select 'sélectionne la cellule A3 de l'onglet OD

CD.Save 'enregistre le fichier destination

Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran

MsgBox "Fin du traitement des données !" 'message

End Sub

je vous remmercie d'avance pour votre aide!!