Enregistrer deux onglets sur dix

Sub Archiver()

Dim extension As String
Dim chemin As String, nomfichier As String
Dim style As Integer
Application.ScreenUpdating = False
ThisWorkbook.ActiveSheet.Copy
extension = ".xlsm"
chemin = "C:\Users\Max\Desktop\Test\"
nomfichier = ActiveSheet.Range("A1") ' & extension
With ActiveWorkbook
      .ActiveSheet.DrawingObjects(2).Delete
    .SaveAs Filename:=chemin & nomfichier
    .Close
End With
End Sub

Option Explicit
Sub test()
Dim i As Integer, x As String, Chemin As String
Workbooks("Matrise.xlsm").Save
Application.DisplayAlerts = False
For i = 10 To 3 Step -1
     Sheets(i).Delete
     Next i
Application.DisplayAlerts = True
x = InputBox("Nom fichier ?")
Chemin = "C:\Users\Max\Desktop\Test\"
If x <> "" Then ActiveWorkbook.SaveAs Chemin & x
End Sub

Sub Archiver()
Dim ext$, chemin$, nomfich$, formatfich
ext = ".xlsm" '.xlsx '.xls 'à adapter
chemin = ThisWorkbook.Path & "\" '"C:\Users\Max\Desktop\Test\"
nomfich = ThisWorkbook.Sheets(1).[A1]
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)
  On Error Resume Next 'si nomfich n'est pas autorisé
  .Sheets(1).DrawingObjects(2).Delete '??
  .SaveAs chemin & nomfich, formatfich
  .Close False
End With
End Sub

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).[A1]
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 o.Name <> "dudu" Then o.Delete
  Next
  On Error Resume Next 'si nomfich n'est pas autorisé
  .Sheets(1).DrawingObjects(2).Delete '??
  .SaveAs chemin & nomfich, formatfich
  .Close False
End With
End Sub

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).[A1]
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 TypeName(o) <> "OLEObject" And o.Name <> "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
End Sub