Save As VBA Code

[Gavin Harrison]

Hi.

I have the below code that works fine to save my workbook as a PDF where the user specifies the location but the filename is specific. I now require if to still be an excel file.

I would also like to add in to the code the ability to delete several of the worksheets within the new workbook to reduce the file size as this file will be saved over and over again.

This is my original code:

Sub Save_Excel_as_PDF()

strfile = ThisWorkbook.Path & "" & strfile
myfile = Application.GetSaveAsFilename _


Application.ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:=Sheets("Great Rooms Report").Range("AI3").Text _

MsgBox "Your report has been saved to the selected folder named as: " & Range("AI3").Value & "."

End Sub


Many thanks
Gavin

 

[Gavin Harrison]

ok, so this is what I have so far, which completes the save as bit, but doesn't allow the user to select a location.

Sub Export()
ActiveWorkbook.SaveAs Filename:=Sheets("Great Rooms Report").Range("AI3").Text, FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:=Password, WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
MsgBox "Your report has been saved to the selected folder named as: " & Range("AI3").Value & "."
End Sub

I did try to add at the beginning....

Application.Dialogs(xlDialogSaveAs).Show

but this then saves 2 copies of the document.

I have also tried to add at the end to delete sheets....

Application.DisplayAlerts = False
Sheets("Sheet1").Delete
Sheets("Sheet2").Delete
Sheets("Sheet3").Delete
Application.DisplayAlerts = True

But it doesn't like that either.

Any help greatly appreciated.

Thanks
Gavin

 

[Fluff]

How about

Sub Save_Excel_as()

    Dim MyFile As String

    MyFile = Application.GetSaveAsFilename(, "Excel Files (*.xlsm), *.xlsm")

    Application.DisplayAlerts = False
    Sheets("Sheet1").Delete
    Sheets("Sheet2").Delete
    Sheets("Sheet3").Delete
    Application.DisplayAlerts = True

    ActiveWorkbook.SaveAs Filename:=MyFile, FileFormat:=52, Password:="Password", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False


End Sub

 

[Gavin Harrison]

Thanks for the reply, I have just tried a different approach, which involves copying the sheets I wanted to save to a new workbook. The below code also allows the user to select the location of the file to be saved at.

Sub Export()
strfile = ThisWorkbook.Path & "" & strfile
myfile = Application.GetSaveAsFilename _
Worksheets(Array("Fri", "Sat", "Sun", "Mon", "Tue", "Wed", "Thur", "Great Rooms Report", "Time Summary", "Time Statistics")).Copy
Set wbNew = ActiveWorkbook
With wbNew
ActiveWorkbook.SaveAs Filename:=Sheets("Great Rooms Report").Range("AI3").Text, FileFormat:=xlOpenXMLWorkbookMacroEnabled
.Close
End With
End Sub

 

[Fluff]

Glad you got it sorted & thanks for the feedback