请大神改改为什么我建的目录连接无效

燕千鸟

Dim arr As Worksheet, i As Integer, str As String


    If Worksheets(1).Name <> "目录" Then
        Worksheets.Add(before:=Worksheets(1)).Name = "目录"
        Worksheets("目录").Range("A1").Value = "序号"
        Worksheets("目录").Range("B1").Value = "目录"
    Else
        Worksheets("目录").Range("A2", "B1045800").ClearContents
    End If
    i = 1


    For Each arr In Worksheets
        Worksheets("目录").Cells(i, "A").Value = i - 1


        Worksheets("目录").Hyperlinks.Add anchor:=Worksheets("目录").Cells(i, "B"), Address:="", _
            SubAddress:=arr.Name & "!A1", TextToDisplay:=arr.Name
        i = i + 1
    Next

附件传不上来，工作表页面多批量大，因为只对最后工作表连接有效，所以希望大神帮改改对所有工作表页面连接都有效

xiangbaoan

Sub addHyperlinks()
Application.Calculation = xlCalculationManual
If Worksheets(1).Name <> "目录" Then
    Worksheets.Add(before:=Worksheets(1)).Name = "目录"
    Worksheets("目录").Range("A1").Resize(1, 2) = [{"序号","目录"}]
Else
    Worksheets("目录").Range("A2", "B1045800").ClearContents
End If
With Worksheets("目录")
    For i = 2 To Worksheets.Count
        .Cells(i, 1) = i
        .Hyperlinks.Add .Cells(i, 2), "#'" & Worksheets(i).Name & "'!A1", , , Worksheets(i).Name
    Next
End With
Application.Calculation = xlCalculationAutomatic
End Sub

abc123281

建议上传附件  并说明详细要求  目的

燕千鸟

xiangbaoan 发表于 2018-10-6 10:23
Sub addHyperlinks()
Application.Calculation = xlCalculationManual
If Worksheets(1).Name  "目录" Th ...

非常感谢 您的帮助 问题已解决 由衷的谢谢

燕千鸟

abc123281 发表于 2018-10-6 10:23
建议上传附件  并说明详细要求  目的

谢谢你的 建议问题也解决