Private Sub CommandButton1_Click()
Dim Fichier As String
Fichier = ActiveWorkbook.Path & '\\' & Replace(ActiveWorkbook.Name, '.xls', '') & '_' & Feuil1.Range('D7').Value & '.xls'
ActiveWorkbook.SaveAs Filename:=Fichier, FileFormat:=xlNormal, Password:='', WriteResPassword:='', ReadOnlyRecommended:=False
End Sub