Save Workbook File With The Next Incrementing Version Number Index

[Admin]

Hi

Not sure about this. BACKUP your original file before trying this solution.

Put this code in the workbook module.

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    
    Dim NewName     As String
    Dim iNum        As Long
    Dim OldName     As String
    Dim FileF       As Long
    Dim FileNm      As String
    
    Const FName     As String = "Ivan Ivanov"
    
    With ThisWorkbook
        OldName = .FullName
        FileF = .FileFormat
        FileNm = Left$(.Name, InStrRev(.Name, ".") - 1)
        iNum = Mid(FileNm, Len(FName) + 1)
        NewName = .Path & Application.PathSeparator & FName & iNum + 1 & ".xlsm"
        Application.DisplayAlerts = False
        Application.EnableEvents = False
        .ChangeFileAccess xlReadOnly
        FileCopy OldName, NewName
    End With
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Kill OldName 'comment this line if you want to keep the old file
    ThisWorkbook.Close 0
End Sub