Sub sobran()
Dim iWshShell As Object
Set iWshShell = CreateObject("WScript.Shell")
    iUser = iWshShell.ExpandEnvironmentStrings("%USERPROFILE%")

Path = iUser & "\Documents\"
FName = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, "."))

i = 1
Err = 0

While Err = 0
    MyFName = Path & FName & "_" & Format(i) & ".pdf"
    Filename = Dir(MyFName)
    If Filename <> "" Then
    i = i + 1
    Else
    Err = 1
    End If
Wend
    
'Печатаем
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False

'Сохраняем
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        MyFName, Quality:=xlQualityStandard _
        , IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub