Enregistrer sous avec une macro

Sub Sauvegarder()
Dim i As Integer
With Application
  .ScreenUpdating = False
  .SheetsInNewWorkbook = Worksheets.Count
  Workbooks.Add
  .SheetsInNewWorkbook = 3
  .DisplayAlerts = False 'au cas où le fichier B.xls existe déjà
End With
With ActiveWorkbook
  For i = 1 To Worksheets.Count 'pour renommer les feuilles
   .Worksheets(i).Name = "zzzzz" & i
  Next
  For i = 1 To Worksheets.Count
    ThisWorkbook.Worksheets(i).Cells.Copy .Worksheets(i).Cells
    .Worksheets(i).Name = ThisWorkbook.Worksheets(i).Name
  Next
  .SaveAs ThisWorkbook.Path & "\B.xls"
  .Close
End With
End Sub

Sub Sauvegarder()
Dim nomfich As String
On Error Resume Next
Workbooks("B.xls").Close False 'nom à adapter
On Error GoTo 0
Application.DisplayAlerts = False 'au cas où le fichier B.xls existe déjà
With ThisWorkbook
  nomfich = .Name
  .SaveAs .Path & "\B.xls" 'chemin et nom à adapter
  Workbooks.Open .Path & "\" & nomfich
End With
Application.OnTime Now, nomfich & "!SupprimerMacros"
End Sub

Sub SupprimerMacros()
Dim w As Worksheet
With Workbooks("B.xls") 'nom à adapter
  .VBProject.VBComponents("Module1").CodeModule.DeleteLines 1, 25
  .VBProject.VBComponents("Feuil1").CodeModule.DeleteLines 1, 3
  For Each w In .Worksheets
    If w.CodeName = "Feuil1" Then w.OLEObjects("CommandButton1").Delete
  Next
  .Close True
End With
End Sub

Sub Sauvegarder()
Dim nomfichier$, fichier$, Fname$, Fcode$, module$, bouton$
'---à adapter---
nomfichier = "B.xls"
fichier = ThisWorkbook.Path & "\" & nomfichier
Fname = Feuil1.Name
Fcode = "Feuil1"
module = "Module1"
bouton = "CommandButton1"
'---sauvegarde---
On Error Resume Next
Workbooks(nomfichier).Close False 'sécurité...
On Error GoTo 0
ThisWorkbook.SaveCopyAs fichier
'---suppression du bouton et des macros (voir n° des lignes)---
Application.ScreenUpdating = False
Workbooks.Open fichier
With Workbooks(nomfichier)
  .Sheets(Fname).OLEObjects(bouton).Delete
  With .VBProject
    .VBComponents(Fcode).CodeModule.DeleteLines 1, 3
    .VBComponents(module).CodeModule.DeleteLines 1, 26
  End With
  .Close True
End With
End Sub