奇数的excel-vba运行时错误，不会删除现有的工作表
我正在运行到这个VBA错误，并不能找出为什么我每次运行macros（第一次两个运行良好），我每次都得到这个错误。
错误是：
“运行时错误”-2147417848（80010108）'：方法'删除'object__Worksheet_failed“
如果代码中已经存在注释，debugging器将指向“ 删除内容表 ”下的“工作表（ContentName）。 删除 ”。
此代码的目的 ：在一张工作表上创build一个目录，该工作表通过工作表名称链接到工作簿中的所有工作表
我有一个button创build运行macros再次更新目录，因为我添加一个新工作表。
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 我打算发表评论，我不能重现错误，但@ mock_blatt给了我一个线索，也许代码运行在一个工作表模块。
用两张纸创build一本新书，将其重命名为“工作列表”，并将代码粘贴到其模块中。 必须为undefined myAnswervariables添加声明。 运行代码。
虽然您可以closures运行代码的工作簿，但您似乎无法从工作表的代码模块中运行的子工具中删除工作表
将你的代码移动到一个标准模块，它应该运行OK。