Bonjour Nabs, bonjour le forum,
Tu n'as pas précisé si il fallait regarder un onglet en particulier ou dans tous ?!...
Le code proposé récupère les données de tous les onglets de tous les classeurs source et renvoie leur valeurs dans l'onglet respectif du classeur destination.
Attention ! Il ne faudrait, dans le dossier de travail, que les classeurs concernés. En effet, s'il y a d'autres fichiers excel, cela risque de venir polluer la synthèse...
Le code :
Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim F As String 'déclare la variable F (Fichier)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim NO As String 'déclare la varable NO (Nom Onglet)
Application.ScreenUpdating = False 'masque les rafraîchissement d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
CA = CD.Path & "\" 'définit le chemin d'accès CA
F = Dir(CA & "*.xlsx") 'définit le premier fichier F du dossier ayant CA comme chemin d'accès
Do While F <> "" 'exécute tant qu'il existe des fichiers F
If F <> ThisWorkbook.Name Then 'condition : si le nom du fichier F n'est pas le nom du classeur destination (SYNTHESE.xlsm)
Workbooks.Open (CA & F) 'ouvre le fichier F
Set CS = ActiveWorkbook 'définit le classeur source SC
For Each OS In CS.Sheets 'bouce sur tous les onglets du classeur source CS
NO = OS.Name 'définit le nom de l'onglet NO
On Error GoTo suite 'gestion des erreurs (en cas d'erreur va à l'étiquette "suite")
CD.Worksheets(NO).Range("A1").CurrentRegion.Offset(1, 0).ClearContents 'efface d'eventuelles anciennes valeurs (génere une érreur si l'onglet NO n'existe pas)
Set DEST = CD.Worksheets(NO).Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
OS.Range("A1").CurrentRegion.Offset(1, 0).Copy 'copie la plage éditée de l'onglet OS
DEST.PasteSpecial (xlPasteValues) 'colle les valeurs dans DEST
suite: 'étiquette
Next OS 'prochain onglet de la boucle
CS.Close SaveChanges:=False 'ferme le classeur source (sans enregistrer)
F = Dir 'définit le prochain fichier F ayant CA comme chemin d'accès
End If 'fin de la condition
Loop 'boucle
End Sub
le fichier (qui prend l'extension .xlsm puisqu'il y a une macro) :