Sub Enregistrer()
Dim NomFichier As String
NomFichier = Range("M1").Value 'Nom du fichier = valeur en M1
If Dir(ThisWorkbook.Path & "\" & NomFichier & ".xlsm") = "" Then 'Vérifie qu'aucun fichier ne porte déjà le même nom
ThisWorkbook.SaveCopyAs Filename:=ThisWorkbook.Path & "\" & NomFichier & ".xlsm" 'Si c'est le cas on crée une copie du fichier
MsgBox "Le fichier " & ThisWorkbook.Path & "\" & NomFichier & " a été créé" 'On averti de l'enregistrement
'----- Suppression code et bouton sur copie
MsgBox "1"
Workbooks.Open ThisWorkbook.Path & "\" & NomFichier & ".xlsm"
MsgBox "2"
With ActiveWorkbook.VBProject.VBComponents(Sheets("FE").CodeName).CodeModule
MsgBox "3"
.DeleteLines 1, .CountOfLines
MsgBox "4"
.CodePane.Window.Close
MsgBox "5"
ActiveSheet.Shapes.Range(Array("Image 3")).Delete
MsgBox "6"
End With
ActiveWorkbook.Close True
'-----
Range("T1").Value = Range("T1") + 1 'On augmente le nom du fichier de 1
Else: MsgBox "Le fichier existe déjà" 'Si le fichier est existant on averti l'utilisateur
End If
End Sub