VBA Save to new workbook

[mrmrf]

Hi.
Looking for VBA code to save the print area to a new excel document and to be prompted for the file path.
I have PDF sorted but can’t seem to get to export to excel document.
Thanks.

Private Sub CommandButton8_Click()
Dim sPath As String
Dim sFile As Variant
Dim ws As Workbook

On Error GoTo ErrHandle
sPath = ThisWorkbook.Path & "\" & ThisWorkbook.Sheets("BH1").Range("G10") 

sFile = Application.GetSaveAsFilename _
    (InitialFileName:=sPath, _
Filefilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and File Name to Save")
If sFile = "False" Then
    MsgBox ("Please Choose a File Name")
Exit Sub
End If

ActiveWorkbook.ExportAsFixedFormat _
    Type:=x1typePDF, _
    Filename:=sFile, _
    Quality:=q1qualitystandard, _
    Includedocproperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
Exit Sub
ErrHandle:
MsgBox ("Document Not Saved")

End Sub

 

[Yongle]

Here is some clear generic code for you to adapt
Currently saves print range in "Sheet XXX" to sheet "PrintRange" in workbook named "MyFileName.xlsx" in folder "C:\folder\subfolder"

Sub SavePrintRange()
    Dim ws As Worksheet, rng As Variant, wb As Workbook, fPath As String, fName As String
[COLOR=#006400]'define path and file name (path ends with [/COLOR]\ [COLOR=#006400])[/COLOR]
    fPath = "[COLOR=#ff0000]C:\folder\subfolder\[/COLOR]"       
    fName = "[COLOR=#ff0000]MyFileName[/COLOR]"
[COLOR=#006400]'range to be copied[/COLOR]
    Set ws = Sheets("[COLOR=#ff0000]Sheet XXX[/COLOR]")
    rng = ws.PageSetup.PrintArea
    Set rng = ws.Range(rng)
[COLOR=#006400]'add a workbook[/COLOR]
    Set wb = Workbooks.Add
[COLOR=#006400]'copy the range[/COLOR]
    rng.Copy
[COLOR=#006400]'paste to new workbook,overwite with values, adjust column widths to match, rename the sheet ...[/COLOR]
     With wb.Sheets(1).Range("A1")
        .PasteSpecial (xlPasteAll)
        .PasteSpecial (xlPasteValues)
        .PasteSpecial (xlPasteColumnWidths)
        .Parent.Name = "[COLOR=#ff0000]PrintRange[/COLOR]"
    End With
[COLOR=#006400]'save and close the workbook[/COLOR]
     wb.SaveAs Filename:=fPath & fName
     wb.Close False
End Sub