Create New Workbook VB

[thomas.szwed]

Hi,

I have the following principle code.

[VBA]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[/VBA]

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.

[VBA] 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[/VBA]
I would be grateful if anyone could provide an answer to this.

Thanks in advance

[Bob Phillips]

[vba]

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
[/vba]

[thomas.szwed]

where in this does it pull in the specific data for the Save As filename?

[thomas.szwed]

This also brings up the runtime error "Copy method of Worksheet class failed" ?????

[Bob Phillips]

What specific data?

Doesn't fail for me. Is the worksheet protected?

[thomas.szwed]

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:

[VBA]

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

[/VBA]

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]

Well that must something in your othercode, that code handles cancel perfectly well.

[thomas.szwed]

how can i change the file save name to that of the this code though?

[VBA]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 [/VBA]

Cheers

[Bob Phillips]

I am sorry, and I don't wish to be rude, but surely you can work that one out?

[thomas.szwed]

I have tried just copying it in but get a runtime error i dont think it likes the filename referencing twice?

[Bob Phillips]

[vba]

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
[/vba]

[thomas.szwed]

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]

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]

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?

[vba]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[/vba]

Thanks

[Bob Phillips]

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]

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