rjplante
Well-known Member
- Joined
- Oct 31, 2008
- Messages
- 569
- Office Version
- 365
- Platform
- Windows
I have a worksheet that I want to save as a separate workbook. I would like to save as dialogue box to appear with an initial file name listed (as a suggestion) which the user can fully edit. I also want tot file format to be defined as xlsx and the file path to match the current file which the user can fully change. I have some of code listed below, which is from a previous version that was much more locked down. I want to have the user select the destination and enter the file name, and then run the rest of the macro to generate the file. What do I have to change to get this to work right.
Current macro code:
Current macro code:
VBA Code:
Sub SAVE_AS_FILE()
Dim sFile As String
Dim Fpath As String
Dim TransferRow As Long
Dim Dest As Workbook
Dim wb As Workbook
Dim Source As Range
Dim FileExtStr As String
Dim FileFormatNum As String
' This will generate the save as dislogue box with the suggested file name in it allowing the user to change the name and file location, but when they select OK, it will just save the file, and not generate the separate sheet.
sFile = Application.GetSaveAsFilename(InitialFileName:="QUOTE# Component List")
Fpath = ThisWorkbook.Path
FileExtStr = ".xlsx": FileFormatNum = 51
' Save sheet with defined name
Sheets("Component List").Activate
TransferRow = Cells(Rows.Count, 1).End(xlUp).Row
' Define the block of data to create a sheet from.
Set Source = Nothing
On Error Resume Next
Set Source = Sheets("Component List").Range("A1:B" & TransferRow)
On Error GoTo 0
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
With Dest
.SaveAs sFile & FileExtStr, FileFormat:=FileFormatNum
End With
'Workbooks(sFile).Activate
ActiveWindow.DisplayGridlines = False
' Save the Component List
With ActiveWorkbook
.Save
.Close SaveChanges:=False
End With
MsgBox "A new spreadsheet has been created and saved as: " & sFile & vbCrLf & _
"In this location: " & Fpath
End Sub