Separer des feuille en plusieurs fichier

Sub test()
    Application.ScreenUpdating = False
    For a = Sheets.Count To 2 Step -1
        Sheets(a).Move
        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Name
        ActiveWorkbook.Close
    Next a
    Application.ScreenUpdating = True
End Sub

Option Explicit
Sub Fichiers_créer()
    Dim o As Long
    Application.ScreenUpdating = 0
    For o = 1 To Sheets.Count
        Sheets(o).Copy
        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Name
        ActiveWindow.Close
    Next
    Application.ScreenUpdating = -1
End Sub

Sub Save_Files()
    Dim ws As Worksheet
    Application.ScreenUpdating = False
    chemin = ThisWorkbook.Path & "\DMP\"
    For Each ws In Worksheets
        ws.Activate
        ActiveSheet.SaveAs Filename:=chemin & ActiveSheet.Name, FileFormat:=xlExcel8
    Next
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    Application.Quit
End Sub

Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
(ByVal hwnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long

Sub CreationDossier(sNomRep As String)
SHCreateDirectoryEx 0&, sNomRep, 0&
End Sub

Sub CreateFolder()
Dim Rep As String, Nom As String
On Error Resume Next
Nom = Format(Date, "yyyy_mm_dd")
Rep = "C:\Users\" & Environ("username") & "\Desktop\" & Nom
CreationDossier Rep
Application.Wait (Now + TimeValue("00:00:01"))
Call SaveSheets
End Sub

Sub SaveSheets()
Dim Wsh, Chemin, Rep, Nm As String, x As Integer, Ws As Worksheet, sh
Set Wsh = CreateObject("WScript.Shell")
Nm = Format(Date, "yyyy_mm_dd")

Chemin = Wsh.SpecialFolders("Desktop") & "\" & Nm & "\"

For Each Ws In Worksheets
Ws.Activate
Ws.SaveAs Filename:= _
       Chemin & Ws.Name & ".xls", _
        FileFormat:=xlExcel8, CreateBackup:=False

'Si il y à des boutons, sinon à enlever
     For Each sh In Ws.Shapes
    If sh.Type = 8 Then sh.Delete
  Next sh
Next Ws
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.Quit
End Sub

ActiveSheet.SaveAs Filename:=