Solved: Invoking the excel saveas screen

[pico]

I'd like to invoke the excel save as screen from a macro and move 2 sheets from the current workbook into a new file. The new file shall be named from the save as screen.

[CBrine]

pico,
Here's the code you require. Modify the copy sheets name and run it. It will add the new workbook and prompt for a save.

HTH
Cal

[VBA]
Dim wb As Workbook
Dim pb As Workbook
Set wb = ActiveWorkbook

Set pb = Workbooks.Add
wb.Sheets("Sheet1").Copy , pb.Sheets(1)
wb.Sheets("Sheet2").Copy , pb.Sheets(1)
pb.Activate
Application.Dialogs(xlDialogSaveAs).Show
Set pb = Nothing
Set wb = Nothing

[/VBA]

[austenr]

Not sure if you want the macro to automatically save the sheets, if you do more info is needed. As for the saveas I think this is what you are looking for:

[VBA]Sub Savefiles()
fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
End Sub[/VBA]

[pico]

Great thanks guys. I will give this a try. Cheers

[pico]

austen: What would i include in the file filter?The code you supplied invokes the screen. But when i type a file name and press save. I cant see the file being created.

[CBrine]

Pico,
Austenr's code will only pull up a non functional dialog that allows you to put a name in. It doesn't actually do anything, you need to code the copy and save.

My code will copy the 2 sheets you need as well as open a fully functional saveas dialog, which works just like the saveas option in the file menu.

HTH
Cal

[pico]

I'd like to save 2 sheets from the workbook that's active. The names of the two sheets are JOB_SPEC_FORM and PARTS1. When a command button is activated from a macro i'd like the save as screen to be displayed. Once the user enters a name and presses the save button i'd like to copy the two sheet from the current workbook to the new workbook created. It would be better if the new workbook created is closed. I dont need to see the information being saved. Just hit save and copy the sheets over to the file created.

[pico]

Iam trying your code at the moment Cbrine. It does not seem to copy the sheets over to the file.

[CBrine]

Pico,
Did you change the names as I instructed?
Your final code needs to look like this.

My code adds a new workbook, copies the two sheets, activates the new workbook with the two sheets, and presents you will a saveas screen. I've added code to close the new workbook as well.
THE CLOSE HAS NO INTELLIGENCE, so if cancel is pressed the new workbook will not be saved, and the workbook will still close.
If save is press in the dialog the file will save as normal.

[vba]
Dim wb As Workbook
Dim pb As Workbook
Set wb = ActiveWorkbook

Set pb = Workbooks.Add
wb.Sheets("JOB_SPEC_FORM ").Copy , pb.Sheets(1)
wb.Sheets("PARTS1").Copy , pb.Sheets(1)
pb.Activate
Application.Dialogs(xlDialogSaveAs).Show
pb.close false
Set pb = Nothing
Set wb = Nothing
[/vba]

HTH
Cal

[pico]

tHANK YOU CBRINE. This is what i was looking for. Cheers

[pico]

The save as screen takes about 30 seconds to load. I think the copy function takes too much time to copy over the sheets. Can i copy a range of cells in a sheet to another workbook instead? Is this possible? Also the sheet i want to copy has a macro. Is there a function where i could only copy the information on the sheet and not the macro over?.

[CBrine]

pico,
Your suggestion on the range of cells copy will take care of both issues. What are the sheets and the ranges you need to copy?
And are they dynamic or static ranges?
If they are dynamic give me the column ranges(ie. A:X) and a column that will always be populated to the last row. This always populated column will be used to determine the last used row for the entire table and to determine the copy area.

Cal

[pico]

There are dynamic values in the sheets. But the M column is static always in both the sheets. In the Job_Spec_form the range is A175:M175, the range for Parts1 sheet is A114:M114. Thank you

[CBrine]

Pico,
These revisions should fix you up.

[VBA]
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim pb As Workbook, ps1 As Worksheet, ps2 As Worksheet
Set wb = ActiveWorkbook
Set ws1 = wb.Sheets("JOB_SPEC_FORM")
Set ws2 = wb.Sheets("PARTS1")
Set pb = Workbooks.Add
Set ps1 = pb.Sheets(1)
Set ps2 = pb.Sheets(2)
ws1.Range("A1", ws1.Range("M" & ws1.Rows.Count).End(xlUp)).Copy ps1.Range("A1")
ws2.Range("A1", ws2.Range("M" & ws2.Rows.Count).End(xlUp)).Copy ps2.Range("A1")
pb.Activate
Application.Dialogs(xlDialogSaveAs).Show
pb.Close False

set ps1=nohting
set ps2=nothing
set wb1=nothing
set wb2 =nothing
Set pb = Nothing
Set wb = Nothing

[/VBA]

[pico]

I tried the code you supplied. It does not copy the sheets over properly. I have attached the Job_spec_form file. Let me know if you can get it working

[CBrine]

OK,
Give this a try.

[VBA]
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim pb As Workbook, ps1 As Worksheet, ps2 As Worksheet
Set wb = ActiveWorkbook
Set ws1 = wb.Sheets("JOB_SPEC_FORM")
Set ws2 = wb.Sheets("PARTS1")
Set pb = Workbooks.Add
Set ps1 = pb.Sheets(1)
Set ps2 = pb.Sheets(2)
ws1.Cells.Copy ps1.Range("A1")
ps1.Activate
ActiveWindow.DisplayGridlines = False
ws2.Cells.Copy ps2.Range("A1")
ps2.Activate
ActiveWindow.DisplayGridlines = False
pb.Activate
Application.Dialogs(xlDialogSaveAs).Show
pb.Close False

Set ps1 = Nothing
Set ps2 = Nothing
Set wb1 = Nothing
Set wb2 = Nothing
Set pb = Nothing
Set wb = Nothing
[/VBA]

[austenr]

That works for me with some modifications. Since the example did not contain the sheet ("PARTS1") you have to comment out that line and where it is referenced later in the code. I put the code in a module and not in the sheet.

[pico]

The code works almost perfectly. Just a question though. Is there any way i can move the checkmarks from the jobspec form to my new sheet?..or is that going to slow down the process?

[CBrine]

pico,
Copying the checkbox will add to the processing time for sure. Here's some code, give it a try and see how long. For me, the complete copy process took only 3 seconds. I just added screen updating disabling code, which might speed it up a bit.

[VBA]
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim pb As Workbook, ps1 As Worksheet, ps2 As Worksheet
Dim s As Shape
Set wb = ActiveWorkbook
Set ws1 = wb.Sheets("JOB_SPEC_FORM")
'Set ws2 = wb.Sheets("PARTS1")
Set pb = Workbooks.Add
Set ps1 = pb.Sheets(1)
Set ps2 = pb.Sheets(2)

application.screenupdating = false
ws1.Cells.Copy ps1.Range("A1")
ps1.Activate
ActiveWindow.DisplayGridlines = False
For Each s In ws1.Shapes
If s.Type = 12 Then
s.Copy
ps1.Paste
End If
Next s
'ws2.Cells.Copy ps2.Range("A1")
'ps2.Activate
'ActiveWindow.DisplayGridlines = False
pb.Activate
Application.Dialogs(xlDialogSaveAs).Show
pb.Close False

application.screenupdating = true
Set ps1 = Nothing
Set ps2 = Nothing
Set wb1 = Nothing
Set wb2 = Nothing
Set pb = Nothing
Set wb = Nothing
[/VBA]

[pico]

Thank you Cbrine and austen for all the help. You guys are awesome . I guess the copy time does take a bit longer than i wanted, but iam assuming this is the best solution so far. Anyway, iam marking this thread as solved. Thanks for all the help.