Solved: Button to save selected sheets to new workbook

[jammer6_9]

I have 10 sheets in a workbook. What I wanted to do is have 1 commandbutton to copy sheet1,sheet2,sheet3 then save it as new workbook. Pls

[jammer6_9]

Code below works BUT how can I copy sheets as values only without formula?

[vba]
Private Sub cmdOK_Click()
Dim wks As Worksheet
Dim strSheet() As String
Dim strNewWB As String
Dim strpath As String
Dim blnFound As Boolean
Dim intWS As Integer
Dim i As Integer

strpath = Application.DefaultFilePath


For i = 0 To lstDept.ListCount - 1
If lstDept.Selected(i) = False Then
ReDim Preserve strSheet(0 To intWS) As String
strSheet(intWS) = lstDept.List(i)

intWS = intWS + 1

Else
If strNewWB = "" Then
strNewWB = lstDept.List(i)
End If
End If
Next i

If UBound(strSheet) = lstDept.ListCount - 1 Then
MsgBox "Please select one or more departments", vbInformation, _
"No Selection Made"
Else
ActiveWorkbook.SaveAs strpath & "\" & strNewWB & ".xls"

Application.DisplayAlerts = False
Sheets(strSheet()).Delete
Application.DisplayAlerts = True

ActiveWorkbook.Save

Unload Me
End If
End Sub[/vba]

[vba]
Private Sub UserForm_Initialize()
Dim wks As Worksheet


For Each wks In ActiveWorkbook.Worksheets
lstDept.AddItem wks.Name
Next wks
End Sub[/vba]

[YellowLabPro]

[VBA]
ActiveSheet.UsedRange = ActiveSheet.UsedRange.Cells.Value
[/VBA]

[daniel_d_n_r]

Once you have your new workbooks with the 3 copied sheets in it run this code over each copy,it seems to work here and removes the formulas, simply by selecting the sheet copying it and pasting it over the sheet again as a past special values only.

a bit messy but simple enough, it may help

cheers

[vba]
Cells.Select
Selection.Copy
Cells.Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
[/vba]

[jammer6_9]

So where can I place this code now?

[vba]
ActiveSheet.UsedRange = ActiveSheet.UsedRange.Cells.Value
[/vba]

[Bob Phillips]

An alternative way

[vba]

ActiveWorkbook.SaveCopyAs "C:\Test\new file.xls"
Set wb = Workbooks.Open("new file.xls")
Application.DisplayAlerts = False
wb.Sheets(Array("Sheet10", "Sheet9", "Sheet8", "Sheet7", "Sheet6", "Sheet5", "Sheet4")). _
Delete
wb.Save
Application.DisplayAlerts = True
[/vba]

[YellowLabPro]

Try it here: But do it on a test copy. As I am not sure where this Private Sub Resides. You basically need to place it right after where your code copies the sheet to the other workbook and that sheet is still active.

[VBA]

Private Sub UserForm_Initialize()
Dim wks As Worksheet


For Each wks In ActiveWorkbook.Worksheets
lstDept.AddItem wks.Name
ActiveSheet.UsedRange = ActiveSheet.UsedRange.Cells.Value
Next wks
End Sub

[/VBA]

[YellowLabPro]

xld-
Falselse?
One detail- I don't see in your code where it will return the sheets w/ values instead of formulae.
That is an elegant way to make a copy, nice..... :-)

[Bob Phillips]

Missed that bit Doug, it was in the follow-up

[vba]

ActiveWorkbook.SaveCopyAs "C:\Test\new file.xls"
Set WB = Workbooks.Open("new file.xls")
Application.DisplayAlerts = False
WB.Sheets(Array("Sheet10", "Sheet9", "Sheet8", "Sheet7", "Sheet6", "Sheet5", "Sheet4")). _
Delete
For Each sh In WB
sh.Cells.Value = sh.Cells.Value
Next sh
WB.Save
Application.DisplayAlerts = True
[/vba]

[YellowLabPro]

jammer- there you have it.... xld's code cuts out any un-needed steps.

If you do try mine, let me know if it worked. I know the one line works, just not sure where your code was looping to copy the sheets to the new workbook, and this is where I would drop in the line I gave you. I opted to use UsedRange.Cells as this will not process the entire sheet which will take longer to go through every cell. But UsedRange has some quirks I have read and so you might experience some results you may not desire. So test both ways..... xld's ensure's against this since it processes all the cells.

[YellowLabPro]

Bob,
Legal?
[vba]WB.Sheets Not in (Array("Sheet1", "Sheet2", "Sheet3")).Delete [/vba]

[Bob Phillips]

Afraid not, you would have to loope and MATCH them.

[jammer6_9]

This is a quick alternative BUT please note that sheet1 is looking up values to one of this sheet that will be deleted so once the sheet is gone, sheet1 value will turn to #REF!...

Missed that bit Doug, it was in the follow-up

[vba]

ActiveWorkbook.SaveCopyAs "C:\Test\new file.xls"
Set WB = Workbooks.Open("new file.xls")
Application.DisplayAlerts = False
WB.Sheets(Array("Sheet10", "Sheet9", "Sheet8", "Sheet7", "Sheet6", "Sheet5", "Sheet4")). _
Delete
For Each sh In WB
sh.Cells.Value = sh.Cells.Value
Next sh
WB.Save
Application.DisplayAlerts = True
[/vba]

[jammer6_9]

This simple code below answers my query... Thanks to all response...

[VBA]
Sheets(Array("Comments", "Audit Summary", "Summary", "Deduction")).Copy
Set wb = ActiveWorkbook
wb.SaveAs ThisWorkbook.Path & "\NewWorkbook.xls"[/VBA]

[Bob Phillips]

What about values witjout formulae?

[jammer6_9]

Well that remain unsolved but I can go on with this code for now. My Boss really wanted me to finished an output ASAP. If you got any solution "sure you have" i will appreciate it...

What about values witjout formulae?

[YellowLabPro]

jammer,
You have a new workbook w/ the desired sheets in this workbook now?
These sheets are the sheets listed in your array-
"Comments", "Audit Summary", "Summary", "Deduction" ?

[jammer6_9]

Yes I do have as I desired. The only thing now is those sheets listed in my array still have formulas link to the OLD Workbook wherein during opening the newworkbook, it still ask the user if they want to update links or not which I wanted to eliminate.

[Bob Phillips]

Just tag that bit of code that I added after Doug's comment onto your cde.

[YellowLabPro]

Just to fully understand-
Which sheet contains the formulas?