Copy method of Worksheet class failed

[Chaplain Doug]

Excel 2003. I have code in an Excel workbook that has worked forever. Now I
am getting the error:

Copy method of Worksheet class failed

In the line below that is ********ed. It successfully copies dozens of
sheets and then begins to fail. The sheet on which it fails is not
protected, nor is the workbook protected. Something just gets grunged in the
workbook. If I close the books and then open them both manually and do the
copy manually, it works fine. What might be the problem?

Also, I also have Excel 2007 installed on this machine. But I am using
Excel 2003 when this problem occurs. Thanks for any help.

Sub Create_YTD_Master_Workbook(YTDBook As String, strYear As String, Success
As Boolean)
Dim MBSearch As String, NextWb As String
Dim I As Integer, J As Integer, NFiles As Integer, JJ As Integer
Dim YTDWbs(1 To 12) As String
Dim YTDWb As Workbook, TempWb As Workbook, sh As Worksheet
Dim YTDWbName As String, Monthstr As String, shName As String
Dim FromRange As Range, ToRange As Range
On Error GoTo CYW_Err
Application.ScreenUpdating = False
'Get monthly master file names in order
Call Get_Monthly_Masters(YTDWbs, strYear, NFiles)
'Create YTD master from monthly books
If NFiles > 0 Then
Application.SheetsInNewWorkbook = 1
Set YTDWb = Workbooks.Add
YTDWbName = strYear + " YTD Master.xls"
Application.DisplayAlerts = False
YTDWb.SaveAs YTDWbName
YTDBook = YTDWb.FullName 'For pass back to calling routine
'Copy first monthly workbook to YTD Master
Call UpdateStatus("Processing " + YTDWbs(1))
Set TempWb = Workbooks.Open(YTDWbs(1), , ReadOnly:=True)
TempWb.Sheets.Copy After:=YTDWb.Sheets(1)
YTDWb.Sheets("Sheet1").Delete 'Remove Sheet 1
TempWb.Close
Application.DisplayAlerts = True
For J = 2 To NFiles
Call UpdateStatus("Processing " + YTDWbs(J))
Set TempWb = Workbooks.Open(YTDWbs(J), , ReadOnly:=True)
TempWb.Unprotect
For I = 1 To TempWb.Sheets.Count
DoEvents
shName = TempWb.Sheets(I).Name
If SheetExists(shName, YTDWb) Then 'Copy the contents onto
existing sheet
JJ = LastRow(YTDWb.Sheets(shName)) + 1
YTDWb.Sheets(shName).Unprotect
TempWb.Sheets(I).UsedRange.Copy
Destination:=YTDWb.Sheets(shName).Range("A" + CStr(JJ))
YTDWb.Sheets(shName).Protect
ElseIf InStr(shName, "Sheet") = 0 Then 'Copy as new sheet
JJ = YTDWb.Sheets.Count
******** TempWb.Sheets(I).Copy After:=YTDWb.Sheets(JJ)
Debug.Print I, JJ, TempWb.Sheets(I).Name
YTDWb.Unprotect
End If
'Remove formulas and replace with fixed values
shName = TempWb.Sheets(I).Name
'Call RemoveFormulas(YTDWb.Sheets(shName))
Next I
'Remove cell names from workbook
Call RemoveNames(YTDWb)
TempWb.Protect
TempWb.Close
Next J
Call RemoveLinks(YTDWb)
Call SortWorkbookSheets(YTDWb)
YTDWb.Save
YTDWb.Protect
YTDWb.Close 'SaveChanges:=True
Success = True
Else
Success = False
End If
CYW_Exit:
Application.ScreenUpdating = True
Exit Sub
CYW_Err:
Resume Next
Success = False
GoTo CYW_Exit
End Sub

 

[Jim Thomlinson]

check out this link...

http://support.microsoft.com/default.aspx?scid=kb;en-us;210684&Product=xlw

 

[Jim Thomlinson]

Give this a whirl...

Public Function LetterToNumber(ByVal Letter As String)
LetterToNumber = Asc(UCase(Letter)) - 64
End Function

Sub test()
MsgBox LetterToNumber("A")
MsgBox LetterToNumber("r")
End Sub

 

[Jim Thomlinson]

Ooops... Wrong Thread...

 

[Chaplain Doug]

Thank you for the quick reply!!!! I added the periodic save/close/reopen and
now the process completes without error. Thanks and God bless.