Enregistrer deux onglets sur dix

Sub Archiver()
Dim ext$, chemin$, nomfich$, formatfich, o As Object
ext = ".xlsm" '.xlsx '.xls 'à adapter
chemin = ThisWorkbook.Path & "\" '"C:\Users\Max\Desktop\Test\"
nomfich = ThisWorkbook.Sheets(1).[K1]
formatfich = xlWorkbookNormal
If Val(Application.Version) >= 12 Then _
formatfich = IIf(ext = ".xls", 56, IIf(ext = ".xlsm", 52, 51))
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier existe déjà
ThisWorkbook.Sheets(1).Copy
With ActiveWorkbook
  ThisWorkbook.Sheets(2).Copy After:=.Sheets(1)
  For Each o In .Sheets(1).DrawingObjects
    If o.Name <> "dudu" And Not o.Name Like "SP*" Then o.Delete
  Next
  .Sheets(1).Activate
  On Error Resume Next 'si nomfich n'est pas autorisé
  .SaveAs chemin & nomfich, formatfich
  .Close False
End With
End Sub

Sub Test()
Dim b As Button
For Each b In Feuil1.Buttons
    If b.Name <> "dudu" Then b.Delete
Next b
End Sub

Sub Archiver()
Dim ext$, chemin$, nomfich$, formatfich, o As Object
ext = ".xlsm" '.xlsx '.xls 'à adapter
chemin = "C:\Users\Dédé\Desktop\Text\"
nomfich = ThisWorkbook.Sheets(1).[K1]
formatfich = xlWorkbookNormal
If Val(Application.Version) >= 12 Then _
formatfich = IIf(ext = ".xls", 56, IIf(ext = ".xlsm", 52, 51))
Application.ScreenUpdating = False
ThisWorkbook.Sheets(1).Copy
With ActiveWorkbook
  ThisWorkbook.Sheets(2).Copy After:=.Sheets(1)



For Each o In .Sheets(1).DrawingObjects
    If Left(o.Name, 3) <> "SP-" And Left(o.Name, 4) <> "dudu" Then o.Delete 
  Next



  
  .Sheets(1).Activate
  On Error Resume Next 'si nomfich n'est pas autorisé
  .SaveAs chemin & nomfich, formatfich
  .Close False
End With