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