backup when save.bas

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

    Call Save_Backup("<Your Backup Folder Directory>")

End Sub

Sub Save_Backup(ByVal Backup_Folder_Path As String)

    Dim fso As Object
    Dim ExtensionName As String, FileName As String
    Dim wbSource As Workbook

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set wbSource = ThisWorkbook

    ExtensionName = fso.GetExtensionName(wbSource.Name)
    FileName = Replace(wbSource.Name, "." & ExtensionName, "")

    fso.CopyFile ThisWorkbook.FullName, _
        fso.BuildPath(Backup_Folder_Path, FileName & " (" & Format(Now(), "mm-dd-yy hhmmssAM/PM") & ")." & ExtensionName)

    Set fso = Nothing
    Set wbSource = Nothing

End Sub