Seanie wrote :
I have stripped down my code and the following is the problem, it
takes 20+ mins to execute. Some facts
Sourcewb = 1.8mb
Destwb = 950k (when it eventually copies)
I have set Calculation to Manual, Screenupdating & EnableEvents to
false
Can't see why copying out from one workbook to a new workbook even 9
sheets would take so long
'Copy the sheets to a new workbook
Sourcewb.Sheets(Array("E-Total Hours", "E-Mail Current Week", "E-
Mail Project v Last Yr Actual", "E-Mail Actual v Last Year", "E-Mail
Comments", "e-Mail Excess", "E-Sales", "E-Splash", "E-Users")).Copy
Set Destwb = ActiveWorkbook
Try this:
Const sWksList As String = "E-Total Hours,E-Mail Current Week,E-Mail
Project v Last Yr Actual,E-Mail Actual v Last Year,E-Mail
Comments,e-Mail Excess,E-Sales,E-Splash"
vWksList = Split(sWksList, ",")
'Copy the sheets to a new workbook
EnableFastCode
Application.DisplayAlerts = False
Set wkbTarget = ActiveWorkbook.Sheets(vWksList).Copy
Application.DisplayAlerts = True
Watch for wordwrap on the (local) Const declaration.
Also, here's another way to do the formatting:
For Each Wks In wkbTarget.Sheets
With Wks
.Activate
bSetFreezePanes Wks.Range("C6").Column, Wks.Range("C6").Row
.EnableSelection = xlNoSelection
.Protect Password:="1234"
End With
Next Wks
Function bSetFreezePanes(lColumn As Long, lRow As Long, Optional bSet
As Boolean = True) As Boolean
On Error GoTo ErrExit
With ActiveWindow
.SplitColumn = lColumn
.SplitRow = lRow
.FreezePanes = bSet
End With
ErrExit:
bSetFreezePanes = (Err = 0)
End Function
Notice that it doesn't require selecting anything.
And.., here's how I would do the formula conversions to values:
'Change all cells in the worksheets to values if you want
' For Each Wks In wkbTarget.Worksheets
' With Wks.UsedRange: .Value = .Value: End With
' Next Wks
HTH
