View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Darren Hill Darren Hill is offline
external usenet poster
 
Posts: 47
Default Peter T's Copy WorkBook Contents Copy

Last month, Peter T posted the macro below.

The intention of this macro:
To copy the contents (including formatting) of each worksheet in a
workbook, to another workbook, and to carry out this copy in such a way
that file corruption is not transferred along with the copy.

The macro works, but there are two glitches that I'm sure would be easy
to fix by someone who knew were doing! :)

1. In the original workbook, there are formulas which refer to cells in
other sheets. After the copy, these formulae refer back to the original
workbook; they aren't local to the new workbook.

2. Page Setup information isn't transferred (several of my worksheets,
but not all, have different Page Sizes, Orientations, and Scales. There
are no headers and footers.

Thanks in advance!

Darren
Peter T's Macro:

Sub WorkBookCopy()
Dim i As Long
Dim ws As Worksheet
Dim wbOrig As Workbook
Dim wbNew As Workbook
Dim nm As Name
Dim nmNew
Dim wsNew As Worksheet

Application.Calculation = xlCalculationManual
Set wbOrig = ThisWorkbook
Application.SheetsInNewWorkbook = 1
Set wbNew = Workbooks.Add
Application.SheetsInNewWorkbook = 3

For Each ws In wbOrig.Worksheets
i = i + 1
If i = 1 Then
wbNew.Worksheets(1).Name = ws.Name
Else
wbNew.Worksheets.Add(after:=wbNew.Worksheets(i - 1)).Name =
ws.Name
End If
Next

With wbNew.Names
' if not 100% sure the nm.RefersTo string is less than 255
' don't use this (could be a lot more work involved)
For Each nm In wbOrig.Names
.Add nm.Name, nm.RefersTo
Next
End With

Application.DisplayAlerts = False
i = 0
With wbNew
For Each ws In wbOrig.Worksheets
i = i + 1
ws.Cells.Copy .Worksheets(i).Cells
Next
End With

Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic

End Sub

Darren