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.
Printable View
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.
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]
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]
Great thanks guys. I will give this a try. Cheers:beerchug:
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.
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
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.
Iam trying your code at the moment Cbrine. It does not seem to copy the sheets over to the file.
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
tHANK YOU CBRINE. This is what i was looking for. Cheers:beerchug:
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?.
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
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
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]
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
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]
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.
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?
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]
Thank you Cbrine and austen for all the help. You guys are awesome:beerchug: . 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. :bow:
As always i come back to a solved thread. Instead of invoking the saveas screen can excel just write to the file and stamp the date and time the file was saved on to the filename?. I came across a loophole where a user could hit cancel and the file might not be saved. :bug:. The location of the file to be saved is a folder in desktop.
pico,
This will force a save before allowing them to exit. They could most likely ctrl-break out of it, but no other way.
[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
Dim response As String
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.ScreenUpdating = True
response = "False"
Do Until response <> "False"
Application.Dialogs(xlDialogSaveAs).Show
Loop
pb.Close False
Set ps1 = Nothing
Set ps2 = Nothing
Set wb1 = Nothing
Set wb2 = Nothing
Set pb = Nothing
Set wb = Nothing
[/vba]
PS-If you want to hard code the save path, that is of course possible, but I figure you must have a reason for asking for the dialog originally.
HTH
Cal
Rats you beat me too it. :thumb
If i press the save button it saves the file ..but the saveas screen does not close. It keeps looping!:whistle:
pico,
Forgot to put my variable into the dialog show.
[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
Dim response As String
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.ScreenUpdating = True
response = "False"
Do Until response <> "False"
response = Application.Dialogs(xlDialogSaveAs).Show
Loop
pb.Close False
Set ps1 = Nothing
Set ps2 = Nothing
Set wb1 = Nothing
Set wb2 = Nothing
Set pb = Nothing
Set wb = Nothing[/VBA]
Great it works. Thank you: pray2:
Hi CBrine, Hope you are still using this forum :bug:
Got some issues with my code. This is the last code that you supplied. There have been some changes to the form i created. I have added a label with a circle in the jobspec form as well. If you scroll down you will be able to see them when you are in design mode.
[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
Dim response As String
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.ScreenUpdating = True
'response = "False"
'Do Until response <> "False"
' response = Application.Dialogs(xlDialogSaveAs).Show
'Loop
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]
I have attached my worksheet as well. When i do the save right now It copies the circles. But they are all the way on top of the copied sheet. Not where i want them to be basically. How can i correct this problem?:think:
I love this forum....folks trying to be the first with a solution!Quote:
Originally Posted by austenr
Can anyone give me a solution to this problem?
Hey pico,
I'm assuming you are referring to the groups of 3 circles around
Yes Groups of 3 circles. There should be 3 for each floor. They are control toolbox labels
Pico,
I'm not sure what is going on it seems like some of the shape objects are corrupted. As soon as I cut and paste them again. The copy seems to work on them? I've attached a copy of the what I did. You are going to need to cut and paste the circle labels back in again.
HTH
Cal
I have the same problem. It does not seem to work for some reason. The type that you specify in vba does that include labels as well? s.type=12 .
Yeah, That's the first thing I checked on. The checkbox's and labels are both type =12.
When I ran the code on my machine, I had some checkbox's not copy correctly as well.
Seems pretty strange, I'm not sure what's occurring.
Have you tried the cut and paste trick I mentioned? The code seems to work after they have been cut and pasted?
Cal
PS- I also checked the format, and properties of ones that copied OK vs the ones that didn't and I was not able to see a difference.
I tried using the cut and paste method. It still does not seem to work.
Ok this is a problem. Instead of saving an excel file i'd like to export the data to a pdf file instead? Is this possible? It does not need to be an excel file the one thats saved. Since this approach is not working i'd like to try exporting my excel sheet to a pdf. How can i achieve this?
pico,
Trying to export to pdf using vba automation, I believe is impossible, since you would need to somehow call the program that convets to pdf. Excel doesn't save to that format natively.
I'm thinking at this point we may want to go back to the original copy of the entire worksheet, and programmatically remove the code that is transferred with it. I can't do much right now, since I'm at home, but should have some time to look at it on Monday.
Cal
Ok. Also i wanted to add another variation to the code.[VBA] Copy to the second sheet only if the checkbox is ticked and only if the labels are visible. Else dont copy the object. [/VBA]. I think this might considerably speed up the process as well. I dont need to look at the objects that are not selected. Just thought that i might add that in there. Btw. I dont have a previous copy of the workbook. I have been working with the same workbook since the start. Pretty much overwriting it.
pico,
I made some adjustments and revised the entire code. Now it copies the entire worksheet once again, and it removes the code that is copied with it. Give it a try and let me know.
[VBA]
Sub CopyData()
Dim VBCodeMod As Object, VBComp As Object
Dim wb As Workbook, ws As Worksheet
Dim pb As Workbook, ps As Worksheet
Dim StartLine As Long
Dim HowManyLines As Long
Dim response As String
Set wb = ActiveWorkbook
Set ws = ActiveSheet
Set pb = Workbooks.Add
ws.Copy pb.Sheets(1)
Set ps = ActiveSheet
With pb.VBProject.VBComponents(ps.CodeName).CodeModule
StartLine = 1
HowManyLines = .CountOfLines
.DeleteLines StartLine, HowManyLines
End With
response = "False"
Do Until response <> "False"
response = Application.Dialogs(xlDialogSaveAs).Show
Loop
pb.Close False
End Sub
[/VBA]
I included the second sheet copy in there as well. But there seems to be some problems. The ws.Copy pb.Sheets(1) code does not work. Cant figure out what the problem is.
[vba]Dim VBCodeMod As Object, VBComp As Object
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim pb As Workbook, ps1 As Worksheet, ps2 As Worksheet
Dim StartLine As Long
Dim HowManyLines As Long
Dim response As String
Set wb = ActiveWorkbook
Set ws1 = wb.Sheets("JOB_SPEC_FORM")
Set ws2 = wb.Sheets("PARTS1")
Set pb = Workbooks.Add
ws1.Copy pb.Sheets(1)
Set ps1 = pb.Sheets(1)
Set ps2 = pb.Sheets(2)
With pb.VBProject.VBComponents(ps1.CodeName).CodeModule
StartLine = 1
HowManyLines = .CountOfLines
.DeleteLines StartLine, HowManyLines
End With
ws2.Cells.Copy ps2.Range("A1")
ps2.Activate
ActiveWindow.DisplayGridlines = False
'response = "False"
' Do Until response <> "False"
' response = Application.Dialogs(xlDialogSaveAs).Show
' Loop
Application.Dialogs(xlDialogSaveAs).Show
pb.Close False
[/vba]