Sub CreerFichiers()
Dim chemin$, exten$, w As Workbook, s As Object
chemin = ThisWorkbook.Path & "\" 'à adapter
exten = Mid(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, "."))
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next 'si caractères interdits pour les noms de fichiers
'---fermeture des fichiers ouverts---
For Each w In Workbooks
If w.Name <> ThisWorkbook.Name Then w.Close
Next
'---création des fichiers---
For Each s In Sheets
s.Visible = True 'sécurité
ThisWorkbook.SaveAs chemin & s.Name, ThisWorkbook.FileFormat
Next
'---réouverture des fichiers---
For Each s In Sheets
If ThisWorkbook.Name <> s.Name & exten Then _
Workbooks.Open chemin & s.Name & exten
Next
'---supression des feuilles---
For Each w In Workbooks
w.Activate 'pour Excel 2010
For Each s In w.Sheets
If w.Name <> s.Name & exten Then s.Delete
Next
w.Save
If w.Name <> ThisWorkbook.Name Then w.Close 'fermeture
Next
Application.Quit 'fermeture d'Excel
End Sub