Procédure d'enregistrement multiple

Hello

Je cherche une procédure pour effectuer un enregistrement multiple de mon classeur...

J'aimerai que quand je click sur la disquette ou par le menu enregistrer, que le classeur soit enregistré sous son nom actuel (classic mode) et que en même temps, il soit enregistré avec la date et l'heure en plus comme copy de sauvegarde...

voilà ce que j'ai fais mais ça plante ?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Cancel = False

LValue = Format(Date, "ddmmyyyy")

ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "Suivi de devis" & LValue & ".xls"

On Error Resume Next

End Sub

je me répond j'ai trouver un code sur le net qui fonctionne super

Public Sub SaveCopy()

Dim strDate As String

Dim Count As integer

Dim PosSep As Intger

Count = Len(ActiveWorkbook.Name)

PosSep = InStrRev(ActiveWorkbook.Name, ".")

'--- Extension xls ou xlsm (3 ou 4 car.)

If PosSep = 0 Then

NameA = ActiveWorkbook.Name

Else

NameA = Left(ActiveWorkbook.Name, PosSep - 1)

End If

'--- Ajout séparateur si besoin

If Right(ActiveWorkbook.Path, 1) <> "\" Then

NameA = ActiveWorkbook.Path & "\" & NameA

Else

NameA = ActiveWorkbook.Path & NameA

End If

'---

strDate = Format(Date, "dd-mm-yy") & "_" & Format(Time, "hh-mm-ss")

ThisWorkbook.SaveCopyAs Filename:=NameA & "_" & strDate & Right(ActiveWorkbook.Name, Count - PosSep + 1)

End Sub