Ian

I assume that there system is still the same.

It may be that the workbook code has got corrupted.

You could try exporting alll the code to a text file.

Deleteing all the modules and worksheet code if you have it and forms and
then importing them back in.

This may solve your problem

If you look here http://www.appspro.com/Utilities/CodeCleaner.htm Rob Bovey
has an excellent add-in that automates this entire process down to
a two mouse clicks.

--
Hope this helps
Martin Fishlock, Bangkok, Thailand
Please do not forget to rate this reply.


"Ian" wrote:

Can anyone help me ... I keep getting the following message

Runtime Error '-2147417848 (80010108)'
Automation Error
The object invoked has disconnected from its clients

The macro in question is listed below and is used to create and name
multiple worksheets by copying a template worksheet called 'TowerMaster'
based on a variable input list. This used to work perfectly until
yesterday... now it crashes after looping through the first time and creates
a copy of 'TowerMaster' called 'TowerMaster (2)' and then stops ?

The VBA code is listd below :

Option Explicit
Sub InitialTowerCreation()

Dim TowerName As Range
Dim NewTowerName As String
Dim iResponse As Integer

iResponse = MsgBox("This Macro should only be used once to create Tower
Worksheets from initial Tower List. Do you wish to Continue ?", vbYesNo)
'display statement to execute if ok
If iResponse = vbNo Then
MsgBox "You selected No"
Exit Sub
End If

If iResponse = vbYes Then
MsgBox "You selected Yes"
End If

Sheets("TowerMaster").Visible = True

For Each TowerName In PickLists.[List_Towers]
If TowerName < "???" Then

NewTowerName = TowerName

Sheets("TowerMaster").Select
Application.CutCopyMode = False
Sheets("TowerMaster").Copy befo=Sheets("TowerMaster")
Sheets("TowerMaster (2)").Select
Sheets("TowerMaster (2)").Name = TowerName

Range("A6:A7").Select
ActiveCell.FormulaR1C1 = TowerName

ActiveWorkbook.Names.Add Name:="Data1_" & TowerName,
RefersToR1C1:= _
"=R11C1:R15C59"
ActiveWorkbook.Names.Add Name:="Data2_" & TowerName,
RefersToR1C1:= _
"=R27C1:R31C59"
ActiveWorkbook.Names.Add Name:="Data3_" & TowerName,
RefersToR1C1:= _
"=R43C1:R47C59"

'create Job Level Validation Range on sheet Job Levels
Sheets("Job Levels").Select
Rows("98:105").Select
Range("B98").Activate
Selection.Insert Shift:=xlDown

Range("Lev_MasterRng").Select
Selection.Copy


Rows("98:98").Select
ActiveSheet.Paste
Range("C98:C105").Select
Application.CutCopyMode = False
ActiveWorkbook.Names.Add Name:="Lev_" & TowerName,
RefersToR1C1:= _
"='Job Levels'!R98C3:R105C3"
Range("a98").Select
ActiveCell.FormulaR1C1 = TowerName

'create Job Level validation on Towersheet
Sheets("TowerMaster").Select
Calculate
Calculate
Sheets(NewTowerName).Select
Range("F11:F14,F16").Select
Range("F16").Activate
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,
Operator:= _
xlBetween, Formula1:="=Lev_" & TowerName
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With


Else
'do nothing
End If


On Error Resume Next

Next TowerName

Sheets("TowerMaster").Select
ActiveWindow.SelectedSheets.Visible = False
Calculate
Sheets("PickLists").Select

RefreshRates

End Sub


This used to work perfectly until yesterday... now it crashes after creating
the first new worksheet from the list ??


--
Regards & Thanks