Sub extraction_fiche()
Application.ScreenUpdating = False
Dim Nouveaufichier As String
Dim utilisateur As String
Nouveaufichier = Range("B5").Value & " (copie)"
utilisateur = Application.UserName
ActiveSheet.Unprotect
Sheets("Fichesynthèse").Select
Sheets("Fichesynthèse").Copy
ActiveSheet.Shapes("Button 6").Delete
ActiveSheet.Shapes("Button 8").Delete
ActiveSheet.Shapes("Button 4").Select
ActiveSheet.Shapes("Button 4").Delete
ActiveSheet.Shapes("Button 2").Delete
ActiveSheet.Shapes("Button 5").Delete
ActiveSheet.Shapes("Button 9").Delete
ActiveSheet.Shapes("Button 1").Delete
ActiveSheet.Shapes("Button 3").Delete
ActiveSheet.Shapes("Button 10").Delete
ActiveSheet.Shapes("Button 11").Delete
Range("A1:H55").Select
Selection.Copy
Range("A1:H1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
On Error Resume Next
ChDir "D:\Documents and Settings\" & utilisateur & "\Desktop"
ActiveWorkbook.SaveAs Nouveaufichier
ActiveWorkbook.RunAutoMacros Which:=xlAutoClose
ActiveWorkbook.Close savechanges:=False
Windows("Fiche de synthèse V3.1.xls").Activate
Range("B2").Select
ActiveSheet.Protect
MsgBox "la fiche " & Nouveaufichier & " est enregistrée sur votre bureau"
Application.ScreenUpdating = True
End Sub