Sub CreateNewFileName() 
     '--------------------------------------------------------------------------------
     'Produces an incremental FileName (if name is 'Data' it creates Data-1.xls)
     'Builds a suffix always one greater than the max suffix of any other potentially
     'existing files that have the same 'root' name, e.g. if 'Data.xls' and 'Data-2.xls'
     'exist, it creates Data-3.xls
     'Helps to avoid overwrite old files (among other uses)
     '--------------------------------------------------------------------------------
    Dim newFileName As String, strPath As String 
    Dim strFileName As String, strExt As String 
    strPath = "C:\AAA\" 'Change to suit
    strFileName = "Data" 'Change to suit
    strExt = ".xls" 'Change to suit
    newFileName = strFileName & "-" & GetNewSuffix(strPath, strFileName, strExt) & strExt 
    MsgBox "The new FileName is: " & newFileName 
     'Save copy
    ActiveWorkbook.SaveCopyAs strPath & newFileName 
End Sub 
 
Function GetNewSuffix(ByVal strPath As String, ByVal strName As String, ByVal strExt As String) As Integer 
    Dim strFile As String, strSuffix As String, intMax As Integer 
    On Error GoTo ErrorHandler 
     'File's name
    strFile = Dir(strPath & "\" & strName & "*") 
    Do While strFile <> "" 
         'File's suffix starts 2 chars after 'root' name (right after the "-")
        strSuffix = Mid(strFile, Len(strName) + 2, Len(strFile) - Len(strName) - Len(strExt) - 1) 
         'FileName is valid if 1st char after name is "-" and suffix is numeric with no dec point
         'Skip file if "." or "," exists in suffix
        If Mid(strFile, Len(strName) + 1, 1) = "-" And CSng(strSuffix) >= 0 And _ 
        InStr(1, strSuffix, ",") = 0 And InStr(1, strSuffix, ".") = 0 Then 
             'Store the max suffix
            If CInt(strSuffix) >= intMax Then intMax = CInt(strSuffix) 
        End If 
NextFile: 
        strFile = Dir 
    Loop 
    GetNewSuffix = intMax + 1 
    Exit Function 
     
ErrorHandler: 
    If Err Then 
        Err.Clear 
        Resume NextFile 
    End If 
End Function