[SIZE=2][COLOR=NAVY]Sub[/COLOR] ExtractionFiche()
Application.ScreenUpdating = [COLOR=NAVY]False
Dim[/COLOR] Nouveaufichier [COLOR=NAVY]As String
Dim[/COLOR] utilisateur [COLOR=NAVY]As String[/COLOR]
Nouveaufichier = Range("B5").Value
utilisateur = Application.UserName
Sheets("Fichesynthèse").Copy
[COLOR=NAVY]With[/COLOR] ActiveSheet
.Unprotect
.DrawingObjects.Delete
.Range("A1:H55").Copy
.Range("A1:H1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=[COLOR=NAVY]False[/COLOR], Transpose:=[COLOR=NAVY]False[/COLOR]
.Range("A1").[COLOR=NAVY]Select[/COLOR]
.Protect
[COLOR=NAVY]End With
With[/COLOR] ActiveWorkbook
.SaveAs Fichier("D:\Documents and Settings\" & utilisateur & "\Desktop", Nouveaufichier)
.[COLOR=NAVY]Close
End With[/COLOR]
Range("B2").[COLOR=NAVY]Select[/COLOR]
MsgBox "la fiche " & Nouveaufichier & " est enregistrée sur votre bureau"
Application.ScreenUpdating = [COLOR=NAVY]True
End Sub[/COLOR]
[COLOR=NAVY]Function[/COLOR] Fichier(Chemin [COLOR=NAVY]As String[/COLOR], Nom [COLOR=NAVY]As String[/COLOR]) [COLOR=NAVY]As String[/COLOR]
[COLOR=GREEN]'myDearFriend![/COLOR]
[COLOR=NAVY]Dim[/COLOR] N [COLOR=NAVY]As Byte
Do[/COLOR]
Fichier = Chemin & Nom & IIf(N, " (" & [COLOR=NAVY]CStr[/COLOR](N) & ")", "") & ".xls"
N = N + 1
[COLOR=NAVY]Loop Until[/COLOR] Dir(Fichier) = ""
[COLOR=NAVY]End Function[/COLOR][/SIZE]