Option Explicit
Sub Copie_Feuille_Active()
Dim chemin$, nom$, cel As Range
Application.ScreenUpdating = False
chemin = ThisWorkbook.Path & "\"
With Feuil1
For Each cel In .Range("a2:a6")
nom = cel.value & ".xls"
.Copy
ActiveSheet.SaveAs Filename:=chemin & nom, FileFormat:=xlExcel8
ActiveWindow.Close
Next cel
End With
End Sub