Fusion de plusieurs fichiers dans un seul.

Bonjour,

Je souhaiterai coller à la suite les unes des autres, une zone de la 8ème feuille de 700 fichier excel dont je dispose et donc la structure est parfaitement identique pour tout ceux là.

J'ai retrouvé ce code là que j'ai adapté : or il n'ouvre pas les autres fichiers pour les copiers quand je lance la macro.

Sub vive()
Range("A2").Select    'sélectionner la cellule de début
Chemin = "C:\Users\Tom\Dropbox (France)\Vivevois"     'saisir le chemin complet du dossier où se trouvent les fichiers
Fichier = Dir(Chemin & "*.xls") ' Premier fichier
Do While Fichier <> ""
    Workbooks.Open Filename:=Chemin & Fichier
    Sheets("DataEnquêteParcelle").Activate
    Range("$A$2:$BQ$41").Copy
    ThisWorkbook.Activate
    ActiveSheet.Paste
    Windows(Fichier).Activate
    Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False
    ThisWorkbook.Activate
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Fichier = Dir ' Fichier suivant
Loop
End Sub

C'est comme si il s'arretait à l'étape sélectionner la case A2 et ne faisait plus rien après.


Que dois-je faire pour qu'il puisse continuer ?

Merci de votre aide.