[Alexej77]

Попробуй так:

Код:

Public flg As Boolean

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If SaveAsUI = True Or flg = True Then Exit Sub
    a$ = Now
    a$ = Replace(a$, ":", ".")
    a$ = Replace(a$, " ", "_")
    a$ = Replace(ThisWorkbook.FullName, ".xls", "") + "_" + a$ + ".xls"
    flg = True
    ActiveWorkbook.SaveAs a$
    Cancel = True
    flg = False
End Sub