奇数excel vba运行时错误和赢得'；不要删除现有的工作表

我遇到了这个VBA错误，无法理解为什么每次运行宏（前两次运行正常）时都会出现这个错误

错误是：

“运行时错误“-2147417848（80010108）”： 对象“”的方法“删除”失败

如果代码中已经存在注释，调试器将指向“删除内容表”下的“工作表（ContentName）.Delete”

此代码的目的：在一张工作表上创建目录，通过工作表名称链接到工作簿中的所有工作表

我创建了一个按钮，用于在添加新工作表时再次运行宏以更新目录

Sub TableOfContents_Create()
'PURPOSE: Add a Table of Contents worksheets to easily navigate to any tab
'SOURCE: www.TheSpreadsheetGuru.com

Dim sht As Worksheet
Dim Content_sht As Worksheet
Dim myArray As Variant
Dim x As Long, y As Long
Dim shtName1 As String, shtName2 As String
Dim ContentName As String

'Inputs
  ContentName = "Job List"

'Optimize Code
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False

'Delete Contents Sheet if it already exists
  On Error Resume Next
    Worksheets("Job List").Activate
  On Error GoTo 0

  If ActiveSheet.Name = ContentName Then
    myAnswer = MsgBox("A worksheet named [" & ContentName & _
      "] has already been created, would you like to replace it?", vbYesNo)

    'Did user select No or Cancel?
      If myAnswer <> vbYes Then GoTo ExitSub

    'Delete old Contents Tab
       Worksheets(ContentName).Delete
  End If

'Create New Contents Sheet
  Worksheets.Add Before:=Worksheets(1)

'Set variable to Contents Sheet
  Set Content_sht = ActiveSheet

'Format Contents Sheet
  With Content_sht
    .Name = ContentName
    .Range("B2") = "Jobs"
    .Range("B2").Font.Bold = True
  End With

'Create Array list with sheet names (excluding Contents)
  ReDim myArray(1 To Worksheets.Count - 1)

  For Each sht In ActiveWorkbook.Worksheets
    If sht.Name <> ContentName Then
      myArray(x + 1) = sht.Name
      x = x + 1
    End If
  Next sht

'Alphabetize Sheet Names in Array List
  For x = LBound(myArray) To UBound(myArray)
    For y = x To UBound(myArray)
      If UCase(myArray(y)) < UCase(myArray(x)) Then
        shtName1 = myArray(x)
        shtName2 = myArray(y)
        myArray(x) = shtName2
        myArray(y) = shtName1
      End If
     Next y
  Next x

'Create Table of Contents
  For x = LBound(myArray) To UBound(myArray)
    Set sht = Worksheets(myArray(x))
    sht.Activate
    With Content_sht
      .Hyperlinks.Add .Cells(x + 2, 3), "", _
      SubAddress:="'" & sht.Name & "'!A1", _
      TextToDisplay:=sht.Name
      .Cells(x + 2, 2).Value = x
    End With
  Next x

Content_sht.Activate
Content_sht.Columns(3).EntireColumn.AutoFit

'A Splash of Guru Formatting! [Optional]
  Columns("A:B").ColumnWidth = 3.86
  Range("B1").Font.Size = 18
  Range("B1:F1").Borders(xlEdgeBottom).Weight = xlThin

  With Range("B3:B" & x + 1)
    .Borders(xlInsideHorizontal).Color = RGB(255, 255, 255)
    .Borders(xlInsideHorizontal).Weight = xlMedium
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Font.Color = RGB(255, 255, 255)
    .Interior.Color = RGB(91, 155, 213)
  End With

'Adjust Zoom and Remove Gridlines
    ActiveWindow.DisplayGridlines = False
    ActiveWindow.Zoom = 130




'Pulls the name of the work book and displays it at the top
    With Content_sht
      .Name = ContentName
      .Range("B1") = ThisWorkbook.Name
      .Range("B1").Font.Bold = True
    End With


'Create a refresh button
    ActiveSheet.Buttons.Add(Range("G4").Left, Range("G4").Top, 90, 25).Select
    Selection.Name = "btnRefreshList"
    Selection.OnAction = "TableOfContents_Create"
    ActiveSheet.Shapes("btnRefreshList").Select
    With Selection
       .Characters.Text = "Refresh List"
        With .Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 12
        End With
    End With

'Create a New Job Button
    ActiveSheet.Buttons.Add(Range("G2").Left, Range("G2").Top, 90, 25).Select
    Selection.Name = "btnNewJob"
    Selection.OnAction = "NewJob"
    ActiveSheet.Shapes("btnNewJob").Select
    With Selection
       .Characters.Text = "New Job"
        With .Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 12
        End With
    End With

ExitSub:
'Optimize Code
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True

End Sub


'Create a new job worksheet
Private Sub NewJob()
Dim ws1 As Worksheet
    Set ws1 = ThisWorkbook.Worksheets("Master")
    ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
End Sub

目录子表\u Create（）
'目的：添加目录工作表以轻松导航到任何选项卡
来源：www.TheSpreadsheetGuru.com
将sht变暗为工作表
将内容设置为工作表
Dim myArray作为变体
尺寸x和长度一样，y和长度一样
Dim shtName1作为字符串，shtName2作为字符串
将ContentName设置为字符串
"投入,
ContentName=“作业列表”
'优化代码
Application.DisplayAlerts=False
Application.ScreenUpdating=False
'删除内容表（如果已存在）
出错时继续下一步
工作表（“工作列表”）。激活
错误转到0
如果ActiveSheet.Name=ContentName，则
myAnswer=MsgBox（“名为[”&ContentName&_
“]已创建，是否替换它？”，vbYesNo）
'用户是否选择了“否”或“取消”？
如果我的答案是肯定的，那么转到出口
'删除旧内容选项卡
工作表（ContentName）。删除
如果结束
'创建新内容页
工作表。在之前添加：=工作表（1）
'将变量设置为内容页
设置内容\u sht=ActiveSheet
'格式目录表
心满意足
.Name=ContentName
.范围（“B2”）=“作业”
.Range（“B2”）.Font.Bold=True
以
'使用工作表名称创建数组列表（不包括内容）
ReDim myArray（1到工作表。计数-1）
对于ActiveWorkbook.工作表中的每个sht
如果是sht.Name ContentName，那么
myArray（x+1）=sht.Name
x=x+1
如果结束
下一步
'按字母顺序排列阵列列表中的工作表名称
对于x=LBound（myArray）到UBound（myArray）
对于y=x到UBound（myArray）
如果UCase（myArray（y））

我想说我无法重现错误，但@mock_blatt给了我一个线索，可能代码正在工作表模块中运行

创建了一本包含两张工作表的新书，将其中一张重命名为“工作列表”，并将代码粘贴到其模块中。必须为未定义的myAnswer变量添加声明。运行代码

虽然可以关闭运行代码的工作簿，但似乎无法从工作表的代码模块中运行的子工作表中删除工作表

---

将代码移动到一个标准模块，它应该可以正常运行。

我想说我无法重现错误，但是@mock_blatt给了我一个线索，可能代码是在一个工作表模块中运行的

创建了一本包含两张工作表的新书，将其中一张重命名为“工作列表”，并将代码粘贴到其模块中。必须为未定义的myAnswer变量添加声明。运行代码

虽然可以关闭运行代码的工作簿，但似乎无法从工作表的代码模块中运行的子工作表中删除工作表

---

将代码移动到标准模块，它应该运行正常。

我可以将此代码粘贴到新的空工作簿中，并反复运行，不会出现错误。运行宏或单击“刷新列表”按钮。我可以改变它