Sub SauvegardeArchive()
Dim Extension As String
Dim iFichier As String
Dim Nom_f As String
Dim APH As String
Dim chemin As String
'Définition du nom
Extension = "Num" & Sheets("Parametres").Range("N18")
Nom_f = ActiveSheet.Name & Extension
'Permet de retrouver le login de la session XP
APH = Environ("UserName")
'Interrompt la mise à jour de l'écran -->accélère l'exécution du code
Application.ScreenUpdating = False
'Copie la feuille active dans un nouveau fichier
ActiveSheet.Copy
'Définition du path complet.
chemin = CreateObject("WScript.Shell").specialFolders("Desktop")
iFichier = chemin & "\" & Nom_f & ".xls"
'Enregistrement du fichier selon le path défini
ActiveWorkbook.SaveAs iFichier
'Fermeture du nouveau classeur sans confirmation
ActiveWorkbook.Close False
' Ré-actualisation de l'affichage.
Application.ScreenUpdating = True
End Sub