View Full Version : Create New Workbook VB
thomas.szwed
09-05-2008, 06:08 AM
Hi,
I have the following principle code.
Sub Print1Copy()
Dim sSheetName As String
On Error Resume Next
sSheetName = Application.VLookup(Range("K10").Value, Range("F117:G125"), 2, False)
On Error GoTo 0
If sSheetName <> "" Then
With Sheets(sSheetName)
.?????????????????????
End With
Else
MsgBox "You have not selected a Contract Type", vbOKOnly + vbInformation, "Information"
End If
End Sub
1. In the bit I have labelled with question marks, I am looking for some code that will copy the sheet (sSheetName) and paste it into a new workbook.
2. As an added extra I would like the new workbook to immediately come up with the 'Save As' dialog box. In this i would like the save as filename to be defaulted to certain cells from my original workbook. I already have code along these lines, see below.
filename = Range("D3").Value
filename = Mid(filename, InStr(filename, " ") + 1) & " " & _
Left(filename, InStr(filename, " ") - 1) & _
", CONTRACT, " & Format(Range("G9").Value, "dd.mm.yy")
filename = Application.GetSaveAsFilename(filename, "Microsoft Excel Files (*.xls), *.xls")
If filename <> False Then
ActiveWorkbook.SaveAs filename
End If
I would be grateful if anyone could provide an answer to this.
Thanks in advance
Bob Phillips
09-05-2008, 06:13 AM
Sub Print1Copy()
Dim sSheetName As String
Dim Filename As Variant
On Error Resume Next
sSheetName = Application.VLookup(Range("K10").Value, Range("F117:G125"), 2, False)
On Error GoTo 0
If sSheetName <> "" Then
Sheets(sSheetName).Copy
Filename = Application.GetSaveAsFilename( _
sSheetName, "Microsoft Excel Files (*.xls), *.xls")
If Filename <> False Then
ActiveWorkbook.SaveAs Filename
End If
Else
MsgBox "You have not selected a Contract Type", vbOKOnly + vbInformation, "Information"
End If
End Sub
thomas.szwed
09-05-2008, 06:23 AM
where in this does it pull in the specific data for the Save As filename?
thomas.szwed
09-05-2008, 06:26 AM
This also brings up the runtime error "Copy method of Worksheet class failed" ?????
Bob Phillips
09-05-2008, 06:32 AM
What specific data?
Doesn't fail for me. Is the worksheet protected?
thomas.szwed
09-05-2008, 06:43 AM
I want it to create a new workbook containing a copy of the sheet selected (sSheetName). And for the saveAs box to come up automatically with the filename populated with the code below:
filename = Range("D3").Value
filename = Mid(filename, InStr(filename, " ") + 1) & " " & _
Left(filename, InStr(filename, " ") - 1) & _
", CONTRACT, " & Format(Range("G9").Value, "dd.mm.yy")
filename = Application.GetSaveAsFilename(filename, "Microsoft Excel Files (*.xls), *.xls")
If filename <> False Then
ActiveWorkbook.SaveAs filename
End If
The cells it would be getting the information from would be from the original workbook on a sheet called INPUT.
Yes actually it is working now, but i can see you have made the filename default to the name of the sheet. This is not what i want. Also if i press cancel i get a runtime error as it seems to be going through all the subs in my other workbook?
Thanks for any help.....
Bob Phillips
09-05-2008, 07:29 AM
Well that must something in your othercode, that code handles cancel perfectly well.
thomas.szwed
09-05-2008, 07:45 AM
how can i change the file save name to that of the this code though?
filename = Range("D3").Value
filename = Mid(filename, InStr(filename, " ") + 1) & " " & _
Left(filename, InStr(filename, " ") - 1) & _
", CONTRACT, " & Format(Range("G9").Value, "dd.mm.yy")
filename = Application.GetSaveAsFilename(filename, "Microsoft Excel Files (*.xls), *.xls")
If filename <> False Then
ActiveWorkbook.SaveAs filename
End If
Cheers
Bob Phillips
09-05-2008, 07:47 AM
I am sorry, and I don't wish to be rude, but surely you can work that one out?
thomas.szwed
09-08-2008, 02:18 AM
I have tried just copying it in but get a runtime error i dont think it likes the filename referencing twice?
Bob Phillips
09-08-2008, 02:33 AM
Sub Print1Copy()
Dim sSheetName As String
Dim Filename As Variant
On Error Resume Next
sSheetName = Application.VLookup(Range("K10").value, Range("F117:G125"), 2, False)
On Error GoTo 0
If sSheetName <> "" Then
Filename = Range("D3").value
Filename = Mid(Filename, InStr(Filename, " ") + 1) & " " & _
Left(Filename, InStr(Filename, " ") - 1) & _
", CONTRACT, " & Format(Range("G9").value, "dd.mm.yy") & ".xls"
Filename = Application.GetSaveAsFilename(Filename, "Microsoft Excel Files (*.xls), *.xls")
If Filename <> False Then
ActiveWorkbook.SaveAs Filename
End If
Else
MsgBox "You have not selected a Contract Type", vbOKOnly + vbInformation, "Information"
End If
End Sub
thomas.szwed
09-09-2008, 07:27 AM
Thanks for the try, this brings back the runtime error "Invalid Call or procedure error."
This is annoying, Do you understand though what i am trying to achieve in this code?
Bob Phillips
09-09-2008, 07:41 AM
Yes I do, but I feel you are drip-feeeding me the info. I have tested everything I have given you and it worked as far as my understanding went at that point.
thomas.szwed
09-09-2008, 07:58 AM
OK. Lets use a different function. The following is taken from another of my projects. The code basically takes a copy of two sheets in the work book and lets the user decide the name of the workbook via an Input Box. In my project i will only require it to copy one sheet.
To adapt this to work in my current project, we can not name the worksheet that we want copied across because it can vary. Therefore i think we would need to use that sSheetName function. Or Maybe not?
The worksheet i required to be copied will always be the second worksheet in my worksheet tab selection at the bottom. I hide all the other sheets when they are not selected. The sheet the user has selected therefore always appears next to the 'INPUT' sheet tab at the bottom.
Could you tell me how i would adapt this code so that it would copy this variable sheet?
Sub EmailLineManager()
Dim msgResponse As String
Application.ScreenUpdating = False
'get user confirmation
msgResponse = MsgBox("This will make a copy of the Contract. Continue?", _
vbInformation + vbYesNo, "Copy Contract")
Select Case msgResponse 'action dependent on response
Case vbYes
'Input box to name new file
Dim newname As String
newname = InputBox("Enter Filename", "Statistics Report", vbOKCancel)
If newname <> vbNullString Then
'Save it with the NewName and in the same directory as original
Sheets(Array("Master Data", "For Archive")).Copy
a = ThisWorkbook.Path & "\" & newname & ".xls"
With a
Sheets("For Archive").Select
Sheets("Master Data").Select
ActiveWorkbook.SaveCopyAs a
ActiveWorkbook.Close False
End With
Else
Exit Sub
End If
Case vbNo
Exit Sub
End Select
End Sub
Thanks
Bob Phillips
09-09-2008, 09:13 AM
So now you are syaing that there is no need to lookup K10 in F117:G125, or get a sheetname from D3 anymore, because it is always the 2nd sheet. So WTF was that all about before?
thomas.szwed
09-10-2008, 01:00 AM
Well yes didnt think it was plausible that way!!!! you should of said!!! Anyway forgetting the old method, could you tell me how to adapt this new code so that it always copies the second sheet???
There may also be the event that a user tries to carry out this function when they haven't made a selection in K10 therefore all the sheets are hidden, so bound to get a runtime error there.....
Thanks
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.