Private Sub CommandButton1_Click()
'ajouter la référence
'"Microsoft visual Basic For Application Extensenbility x.x"
Dim Suggere As Variant
Dim Reponse As Variant
Suggere = "A remplacer par votre variable nom"
On Error GoTo Erreur
Application.ScreenUpdating = False
ThisWorkbook.Sheets(1).Copy
ActiveWorkbook.ActiveSheet.DrawingObjects.Delete
With Workbooks(ActiveWorkbook.Name).VBProject.VBComponents(ActiveSheet.Name).CodeModule
.DeleteLines 1, .CountOfLines
End With
Reponse = Application.GetSaveAsFilename(InitialFileName:=Suggere, _
fileFilter:="Classeur Microsoft Excel (*.xls), *.xls")
If Reponse <> False Then ActiveWorkbook.SaveAs Filename:=Reponse
Erreur:
End Sub