Sauvegarde à la fermeture d'un classeur

[sev]

Bonjour à tous,

Je joint un code trouvé sur le net que je n'arrive pas à appliquer sur mon classeur :
Je voudrais qu'à la fermeture du classeur un msgbox me propose ( oui ou non) la sauvegarde incrémentée du dit classeur sur une clé USB.
Et ceci en proposant l'enregistrement des modifications dans l'emplacement d'origine le disque dur.

Je vous remercie d'avance de votre aide





Private Sub Workbook_BeforeClose(Cancel As Boolean)

MsgBox "Sauvegarder le classeur sur une clé USB ?", vbQuestion + vbYesNo, "Sauvegarde"
If vbYes = True Then




'Ajuster cette constante pour modifier le nombre
'de sauvegardes quotidiennes
Const NbVersions As Integer = 2
End If
End Sub
Sub SauvegardeIncrementee()
Dim Wbk As Workbook, NomF As String, NNom As String, NNomMin As String
Dim StrDate As String, Message As String, Reponse, MaxV As Integer
Dim Chemin As String, Ext As String
Dim Fs As Object, Bcle As Integer

On Error GoTo erreur
Set Fs = CreateObject("Scripting.FileSystemObject")

Set Wbk = ActiveWorkbook
If Wbk Is Nothing Then Exit Sub
With Wbk
.Save
NomF = .Name
Chemin = .Path & "F:\"
Ext = Mid(NomF, InStrRev(NomF, "."))

If Ext = "." Then
MsgBox "Erreur, ce fichier n'est pas sauvegardé", vbInformation, "Sauvegarde"
Exit Sub
End If
End With

NomF = Left$(NomF, InStrRev(NomF, ".") - 1)

If Mid$(NomF, Len(NomF) - 2, 1) = "-" Then
If IsNumeric(Right$(NomF, 2)) Then NomF = Trim(Left$(NomF, Len(NomF) - 3))
End If
If Len(NomF) > 8 Then
If IsDate(Replace(Right$(NomF, 8), "_", "/")) Then
NomF = Trim(Left$(NomF, Len(NomF) - 8))
Message = "Ce fichier est déjà un fichier de sauvegarde incrémentée..." & _
vbCr & "Le sauvegarder sous " & NomF & Ext & " ?"
Reponse = MsgBox(Message, vbInformation + vbYesNo, "Sauvegarde")
If Reponse = vbNo Then Exit Sub
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Chemin & Trim(NomF) & Ext
Application.DisplayAlerts = True
End If
End If

For Bcle = 1 To NbVersions
NNom = NomF & " " & Format(Date, "dd_mm_yy") & Format(Bcle, "-00")
NNomMin = NomF & " " & Format(Date, "dd_mm_yy") & Format(Bcle - 1, "-00")
On Error Resume Next
Set Wbk = Nothing
Set Wbk = Workbooks(NNom & Ext)
If Not Wbk Is Nothing Then
MsgBox "Erreur, le fichier " & NNom & Ext & " doit être fermé", vbInformation, "Sauvegarde"
Exit Sub
End If
On Error GoTo erreur
NNom = Chemin & NNom & Ext
If Dir(NNom) <> "" Then MaxV = MaxV + 1
If MaxV > 1 Then
If MaxV = Bcle Then
Fs.CopyFile NNom, Chemin & NNomMin & Ext, True
Else
Exit For
End If
End If
Next Bcle
Set Fs = Nothing

If MaxV < NbVersions Then MaxV = MaxV + 1
NNom = NomF & " " & Format(Date, "dd_mm_yy") & Format(MaxV, "-00")
ActiveWorkbook.SaveCopyAs Chemin & NNom & Ext
Exit Sub

erreur:
Application.DisplayAlerts = True
MsgBox "Erreur à la sauvegarde...", vbInformation, "Sauvegarde"
End Sub


End If

If vbNo = True Then Exit Sub
End Sub