Sub SaveAsNextNumber()
Dim oldName As String, newName As String, sExt As String
Dim i As Long
oldName = ActiveWorkbook.FullName
sExt = "." & Split(oldName, ".")(UBound(Split(oldName, ".")))
oldName = Left(oldName, Len(oldName) - Len(sExt))
i = Len(oldName)
If Right(oldName, 1) Like "#" Then
Do While Mid(oldName, i - 1, 1) Like "#"
i = i - 1
Loop
newName = Left(oldName, i - 1) & Mid(oldName, i) + 1 & sExt
Else
newName = oldName & 1 & sExt
End If
ActiveWorkbook.SaveAs Filename:=newName
End Sub