Copying workbook and saving to new file

Hi All,

I have the following code (see end of message) that should select only a certain number of worksheets from the original file and then save the selected files as a new work book.

The reason I want to do this is because I would like to share the workbook with other people, however not all of the workbook because the original file has sensitive data in it. The idea is that by pressing a button a predefined selection of worksheets are copied and then saved in a separate workbook.

This is currently half working.

Basically at the moment if I comment out the line:
'ws.Cells.PasteSpecial Paste:=xlValues

The process works fine. The problem however is that the copied workbook contains links to the original file. Consequently if I e-mail this sheet my values appear as broken links (i.e. ####) .

I really need to get the Past Values option to work – any help would be much appreciated.

Regards,

Kevin

Sub Button9_Click()

Dim NewName As String
Dim nm As Name
Dim ws As Worksheet

If MsgBox("Copy the 'Quarterly Report' sheet to a new file to e-mail to DAAT" _
, 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("i. Guidance", "ii. Contents", "1. Perf", "2. InfoNeeds", "3. ServDevel", "4. StaffDevel", "6. Incidents", "7. Partnership", "8. Finance")).Copy
'Modules(Array("Module1", "Module2")).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.Cells.PasteSpecial Paste:=xlValues
ws.Cells.Hyperlinks.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")


' Save it with the NewName and in the same directory as original
ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"
ActiveWorkbook.Close SaveChanges:=False

.ScreenUpdating = True

MsgBox ThisWorkbook.Path & "\" & NewName & ".xls saved."
End With


Exit Sub



ErrCatcher:

MsgBox "Specified sheets do not exist within this workbook"

End Sub