Solved: Copy Sheets to a New workbook

[mduff]

I have been trying to find things to resolve this on the internet but am running short on luck

What I need to Copy 3 sheets (all data) form one workbook to new Workbook as just values and Formats (no Formulas) then call on the save as dialog and let the user save the new file


Any help would be appreciated


For what it is wroth this is what I have so Far

Sub CopySomeSheetsToNewWorkbook()
Dim wbNew As Workbook
Sheets(Array(Daily, Sam)).Copy.Values.Formats


Set wbNew = ActiveWorkbook

With wbNew
Application.GetSaveAsFilename
End With




End Sub

:banghead:

[mduff]

I got this one from an other post thanks any way for the help

[mdmackillop]

Can you post a link to the solution for the benefit of others?

[mduff]

Sure

http://www.vbaexpress.com/kb/getarticle.php?kb_id=359 (http://www.vbaexpress.com/kb/getarticle.php?kb_id=359)

[mduff]

Hi I guess I should not have closed this so fast :( can anyone tell me what I need to add to remove all From Control buttons from any sheet in the array copied

Thanks so much
Sub TwoSheetsAndYourOut()
Dim NewName As String
Dim nm As Name
Dim ws As Worksheet
Dim obj As OLEObject
If MsgBox("Copy specific sheets to a new workbook" & vbCr & _
"New sheets will be pasted as values, named ranges removed" _
, vbYesNo, "NewCopy") = vbNo Then Exit Sub
With Application
.ScreenUpdating = False
' Copy specific sheets
' *SET THE SHEET NAMES TO COPY BELOW*
' Array("Sheet Name", "Another sheet name", "And Another"))
' Sheet names go inside quotes, seperated by commas
On Error GoTo ErrCatcher
Sheets(Array("Daily", "Sam")).Copy
On Error GoTo 0
' Paste sheets as values
' Remove External Links, Hperlinks and hard-code formulas
' Make sure A1 is selected on all sheets
For Each ws In ActiveWorkbook.Worksheets
ws.Cells.Copy
ws.[A1].PasteSpecial Paste:=xlValues
ws.Cells.Hyperlinks.Delete
'' ws.OLEObjects.Delete
Application.CutCopyMode = False
Cells(1, 1).Select
ws.Activate
Next ws
Cells(1, 1).Select
' Remove named ranges
'''For Each nm In ActiveWorkbook.Names
'''nm.Delete
'''Next nm
' Input box to name new file
NewName = InputBox("Please Specify the name of your new workbook", "New Copy", "COF" & Format(Date, "MM.DD.YY"))
' Save it with the NewName and in the same directory as original
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & NewName & ".xls"
''ActiveWorkbook.Close SaveChanges:=False
.ScreenUpdating = True
End With
Exit Sub
ErrCatcher:
MsgBox "Specified sheets do not exist within this workbook"
End Sub