Sub Save()
    Dim F_Filename As String, Folder As String

    With Application
        .DisplayAlerts = False

        With ActiveSheet
            Set FSO = CreateObject("Scripting.FileSystemObject")
            F_Filename = Split(.[D2], ".")(0)
            Folder = .[D1] & F_Filename
            If Not FSO.FolderExists(Folder) Then FSO.CreateFolder Folder
            Set FSO = Nothing
            .PageSetup.PrintArea = Application.InputBox("Выделите область печати", Default:="$A$1:$C$26", Type:=2)
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                    Filename:= _
                Folder & "\" & .[D2], _
                    Quality:=xlQualityHigh, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False
        End With

        .DisplayAlerts = True
    End With
 End Sub