Sub мяу()
Dim i&
    On Error Resume Next
    MkDir ("D:\A")
    If Err.Number = 0 Then Exit Sub
    i = 1
    Do
        Err.Clear
        MkDir ("D:\A" & i)
        i = i + 1
        DoEvents
    Loop Until Err.Number = 0
End Sub

Sub Test()
SavePath = SaveFolder("C:\021")
End Sub

Function SaveFolder(ByVal SavePath As String) As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(SavePath) Then
        FSO.CreateFolder SavePath
        SaveFolder = SavePath
        Set FSO = Nothing
        Exit Function
    End If
    Dim BaseName As String, BaseName1 As String
    BaseName = FSO.GetBaseName(SavePath)
    BaseName1 = FSO.GetBaseName(SavePath)
    SavePath = FSO.GetParentFolderName(SavePath)
    Dim tempCount As Integer
    Do While FSO.FolderExists(FSO.BuildPath(SavePath, BaseName))
        tempCount = tempCount + 1
        BaseName = BaseName1 & "[" & tempCount & "]"
    Loop
  SavePath = FSO.BuildPath(SavePath, BaseName)
       If Not FSO.FolderExists(SavePath) Then
        FSO.CreateFolder SavePath
    End If
    Set FSO = Nothing
     SaveFolder = SavePath
End Function

FileName =  Worksheets("Титульный").Range("AA20").Text + "_" + Worksheets("Титульный").Range("M29").Text + ".xlsm"
    ActiveWorkbook.SaveCopyAs SavePath & "\" & FileName