Récupérer données venant de plusieurs feuilles

Sub Recup()
Dim Fichier() As String
Dim Lecture As String, Chemin As String
Dim Compte As Long
Dim NomFichier As Variant
Dim Onglet As Worksheet
Dim Nom As String, Retour As String
Dim Ligne As Long
Dim Trouve As Range
' Boucle de lecture des fichiers dans un répertoire
Chemin = Range("E11")
Lecture = Dir(Chemin & "*.xls*")
Compte = 0

'Récupération de la liste des fichiers du dossier
Do
 ReDim Preserve Fichier(Compte)
 Fichier(UBound(Fichier)) = Lecture
 Lecture = Dir
 Compte = Compte + 1
Loop Until Lecture = ""

'Analyse et recopie éventuelle des onglets Stats
For Each NomFichier In Fichier
Workbooks.Open Filename:=Chemin & NomFichier, ReadOnly:=True
For Each Onglet In Workbooks(NomFichier).Worksheets
    If Onglet.Name = "Stats" Then
    Nom = Onglet.Range("A1").Value
    Set Trouve = ThisWorkbook.Sheets("Reception").Range("A:A").Find(Nom, lookat:=xlWhole)
    If Not Trouve Is Nothing Then
       Retour = MsgBox("Nom figurant déjà dans la liste réception, voulez vous continuer", vbYesNo, "ALERTE DOUBLONS")
       If Retour = vbYes Then GoTo Reprise
     Else
Reprise:
       Onglet.Copy after:=ThisWorkbook.Worksheets("Reception")
       ThisWorkbook.Worksheets("Stats").Name = Nom
       Ligne = ThisWorkbook.Sheets("Reception").Range("A" & Rows.Count).End(xlUp).Row + 1
       ThisWorkbook.Sheets("Reception").Range("A" & Ligne) = Nom
       ThisWorkbook.Sheets("Reception").Range("B" & Ligne) = Format(Date, "dd-mm-yyyy")
       Exit For
    End If
  End If
 Next
 Workbooks(NomFichier).Close False
Next
End Sub