Save to Excel instead of PDF? (with Save As prompt)

[scottaz]

When the code below is executed it prompts the user to choose the location they want to save on their computer (also inputs a default filename from values in the sheet) and prints the range to PDF.

Worksheets("Sheet1").Activate


filename = Application.GetSaveAsFilename(InitialFileName:=Sheets("Sheet1").Range("K3").Value, _
                                     FileFilter:="PDF Files (*.pdf), *.pdf", _
                                     Title:="Select Path and Filename to save")

If filename <> "False" Then
With ActiveWorkbook
    .Worksheets("Sheet1").Range("A1:I119").ExportAsFixedFormat Type:=xlTypePDF, _
                                              filename:=filename, _
                                              Quality:=xlQualityStandard, _
                                              IncludeDocProperties:=True, _
                                              IgnorePrintAreas:=False, _
                                              OpenAfterPublish:=True
End With
End If

The problem is... I now need to save to Excel instead. I have been playing with different solutions to save the worksheet to a new workbook, but can not find one that prompts the user to save as. Also, I have a couple of buttons on the sheet that activate macros. I would like to delete/hide these in the new workbook.

Any suggestions would be greatly appreciated!

 

[AlphaFrog]

[color=darkblue]Sub[/color] Save_Sheet_As_xlsx()
    [color=darkblue]Dim[/color] Filename  [color=darkblue]As[/color] [color=darkblue]String[/color], shp [color=darkblue]As[/color] Shape
    Worksheets("Sheet1").Activate
    Application.ScreenUpdating = [color=darkblue]False[/color]
    Filename = Application.GetSaveAsFilename(InitialFileName:=Sheets("Sheet1").Range("K3").Value, _
                                             FileFilter:="Excel Files, *.xlsx", _
                                             Title:="Select Path and Filename to save")
    
    [color=darkblue]If[/color] Filename <> "False" [color=darkblue]Then[/color]
        ActiveWorkbook.Worksheets("Sheet1").Copy
        [color=darkblue]For[/color] [color=darkblue]Each[/color] shp [color=darkblue]In[/color] ActiveSheet.Shapes
            shp.Delete
        [color=darkblue]Next[/color] shp
        ActiveWorkbook.SaveAs Filename, FileFormat:=51  [color=green]'xlOpenXMLWorkbook (without macro's in 2007-2013, xlsx)[/color]
        ActiveWorkbook.Close [color=darkblue]False[/color]
        Application.ScreenUpdating = [color=darkblue]True[/color]
        MsgBox Filename, , "Save Complete"
    [color=darkblue]End[/color] [color=darkblue]If[/color]
End [color=darkblue]Sub[/color]

 

[scottaz]

That's exactly what I was looking for! Thank you!

Is there a way to modify this to open the new excel document instead of the "Save Complete" prompt?

 

[AlphaFrog]

You're welcome.
Just comment out the .Close and the MsgBox lines

[COLOR=darkblue]Sub[/COLOR] Save_Sheet_As_xlsx()
    [COLOR=darkblue]Dim[/COLOR] Filename  [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], shp [COLOR=darkblue]As[/COLOR] Shape
    Worksheets("Sheet1").Activate
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    Filename = Application.GetSaveAsFilename(InitialFileName:=Sheets("Sheet1").Range("K3").Value, _
                                             FileFilter:="Excel Files, *.xlsx", _
                                             Title:="Select Path and Filename to save")
    
    [COLOR=darkblue]If[/COLOR] Filename <> "False" [COLOR=darkblue]Then[/COLOR]
        ActiveWorkbook.Worksheets("Sheet1").Copy
        [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] shp [COLOR=darkblue]In[/COLOR] ActiveSheet.Shapes
            shp.Delete
        [COLOR=darkblue]Next[/COLOR] shp
        ActiveWorkbook.SaveAs Filename, FileFormat:=51  [COLOR=green]'xlOpenXMLWorkbook (without macro's in 2007-2013, xlsx)[/COLOR]
        [B][COLOR=#008000]'ActiveWorkbook.Close False[/COLOR][/B]         
        [B][COLOR=#008000]'MsgBox Filename, , "Save Complete"[/COLOR][/B]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If
[/COLOR]    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
End [COLOR=darkblue]Sub[/COLOR]