multiple worksheets in a workbook, each saved on its own.

[John]

I need to take a workbook file with multiple worksheets and save these
individually, however the masterfile containes external links to other source
documents and I need to break the data links.

I've been using this code to copy the worksheets

Sub Make_New_Books()
Dim w As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each w In ActiveWorkbook.Worksheets
w.Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & w.Name
ActiveWorkbook.Close
Next w
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

I've recorded a marco with the select all copy paste special values, however
I get a error when I add this code to this macro.

Any suggestions to this would be appreciated. I need to have the worksheet
copied as this contains print layouts etc and formatting that need to be
maintained in the copy.

Thanks in advance..

John

 

[Ron de Bruin]

Hi John

Changed this macro for you
http://www.rondebruin.nl/copy6.htm

Sub Copy_All_Sheets_To_New_Workbook()
Dim WbMain As Workbook
Dim Wb As Workbook
Dim sh As Worksheet
Dim DateString As String
Dim FolderName As String

Application.ScreenUpdating = False
Application.EnableEvents = False

DateString = Format(Now, "yy-mm-dd hh-mm-ss")
Set WbMain = ThisWorkbook
FolderName = WbMain.Path & "\" & Left(WbMain.Name, Len(WbMain.Name) - 4) _
& " " & DateString
MkDir FolderName

For Each sh In WbMain.Worksheets
If sh.Visible = -1 Then
sh.Copy
Set Wb = ActiveWorkbook
With Wb.Sheets(1).UsedRange
.Value = .Value
End With
Wb.SaveAs FolderName _
& "\" & Wb.Sheets(1).Name & ".xls"
Wb.Close False
End If
Next sh

MsgBox "Look in " & FolderName & " for the files"
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[John]

Hi Ron

Like the code, but still have the same problem.

In my master workbook, this contains a link to another Excel file ie
Sale_Feb05, When I copy the worksheet, it copies the external links also. I
need these links removed but the values to remain.

Thanks for the quick response

 

[Ron de Bruin]

Use this then

With Wb.Sheets(1)
Cells.Copy
Cells.PasteSpecial xlPasteValues
Cells(1).Select
Application.CutCopyMode = False
End With

Instead of

 

[Ron de Bruin]

With dots before cells

With Wb.Sheets(1)
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells(1).Select
Application.CutCopyMode = False
End With

 

[John]

Thank you very much,

I forgot to take the comment tags out.. Opps. both work great.

Great website you got their. Loads of great tips. you've been added to my
fav's

Cheers
John