Sub ChercheetOuvreFichier()
Dim classeur As Workbook
Dim cellule As Range
Dim i As Long
Dim j As Long
Dim classeur1 As String
Dim classeur2 As String
Dim dl1 As Long
dim nomfich As String
dim Chemin As String
Chemin = ThisWorkbook.path & "\"
monfichier = Dir(Chemin & "*.xls")
classeur1 = ActiveWorkbook.Name
Application.DisplayAlerts = False 'interdit les messages d'avertissements
Do Until monfichier = ""
If monfichier <> classeur1 Then
'Label3.Caption = Chemin & monfichier
' ouverture du classeur
Set classeur = GetObject(Chemin & monfichier)
classeur2 = classeur.Name
'Call copiedonnee(classeur1, "Feuil1", classeur2, "")
Workbooks(classeur2).Sheets(1).Copy after:=Workbooks(classeur1).Sheets(Worksheets.Count)
' fermeturefichier (monfichier)
Workbooks(monfichier).Close False
End If
monfichier = Dir ' fichier suivant
Loop
Application.DisplayAlerts = True
End Sub