Sub 获取工作表名称()
    Columns("A:A").Select
    Selection.ClearContents
i = 1
For Each sh In Sheets
Cells(i, 1) = sh.Name
i = i + 1
Sheets("目录").Hyperlinks.Add Anchor:=Sheets("目录").Cells(i, 1), _
Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", _
TextToDisplay:=Sheets(i).Name, ScreenTip:="单击打开：" & Sheets(i).Name
Next
End Sub
Function IsSht(ShtName As String)
On Error Resume Next
Dim sht As Worksheet
Set sht = Sheets(ShtName)
IsSht = (Err = 0)
End Function
Sub 返回目录()
'如果有“目录”则返回“目录”工作表
If IsSht("目录") Then Sheets("目录").Select
End Sub

i = 1                        '起始
For Each sh In Sheets
Cells(i, 1) = sh.Name      
i = i + 1                    '下一个

Sheets("目录").Hyperlinks.Add Anchor:=Sheets("目录").Cells(i, 1), _
Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", _
TextToDisplay:=Sheets(i).Name, ScreenTip:="单击打开：" & Sheets(i).Name

这句里面，有这节，
Sheets(i).Name
当所有的工作表都索引完后，i 的值仍然是下一个可能工作表的编号，但这时工作表都已索引完了，也已经 i 大于了工作表的总数，这节就导致 下标越界。

谢谢大侠，请问怎么更改？谢谢！

把 i=i+1 放到 这句后面，也就是 next 上面一行就是了。

你没发现你这里生成的内容不对吗？
Sheets("目录").Hyperlinks.Add Anchor:=Sheets("目录").Cells(i, 1), _
Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", _
TextToDisplay:=Sheets(i).Name, ScreenTip:="单击打开：" & Sheets(i).Name

谢谢大侠！