Sub Test()
Dim Chemin As String, Dossier As Object, Fichier As Object, Classeur As Workbook, Feuille As Worksheet
Chemin = "F:\CONGES2\PERSONNEL\YVELINES OUEST\GUYANCOURT\- DECOMPTES TEMPS\"
Application.ScreenUpdating = False
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each Fichier In Dossier.Files
If Fichier.Name <> ThisWorkbook.Name And Right(Fichier.Name, 4) = ".xls" Then
Workbooks.Open (Chemin & Fichier.Name)
Set Classeur = ActiveWorkbook
For Each Feuille In Classeur.Worksheets
If Feuille.Name = "SEM1" Then
Feuille.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ThisWorkbook.Sheets("SEM1").Name = Replace(Fichier.Name, ".xls", "")
End If
Next Feuille
Classeur.Close False
End If
Next Fichier
Application.ScreenUpdating = True
End Sub