Question

我遇到了一个问题，我希望有人可以帮忙。

我的工作簿上有一个索引表，其中包含工作簿中所有其他工作表的概述。我正在尝试自动创建指向索引表上各个工作表的超链接。

我已将流程自动化到创建链接的位置，但我无法弄清楚如何让超链接指向复制信息的工作表。这是我到目前为止所做的：

Sub PasteOverview()
With ActiveSheet
Link = Range("D3")
Range("B42:J42").Select
Selection.Copy
Range("A1").Select
Sheets("Active").Select
Cells(Range("B10000").End(xlUp).Row + 1, 2).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveSheet.Paste Link:=True
Range("C" & (ActiveCell.Row)).Select
ActiveSheet.Hyperlinks.Add ActiveCell, "", "Link"
End With
End Sub

我无法弄清楚如何让超链接指向从中复制信息的工作表。任何帮助将不胜感激。

编辑：重新阅读我的问题我看到措辞很差，因为我不清楚我是否想要超链接到最后一个活动工作表或最初复制信息的工作表。我已经重新澄清了这个问题。

Answer 1

试一试：

Option Explicit

Sub PasteOverview()

    Dim wsCopy As Worksheet
    Set wsCopy = ActiveSheet

    With wsCopy

        Dim link As String
        link = .Range("D3").Address(False, False)
        .Range("B42:J42").Copy

    End With

    With Worksheets("Active")

        Dim nextRow As Long
        nextRow = .Range("B10000").End(xlUp).Offset(1).Row
        .Range("B" & nextRow).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        ActiveSheet.Paste link:=True
        .Hyperlinks.Add .Range("C" & nextRow), "", wsCopy.Name & "!" & link, wsCopy.Name & "!" & link

    End With

End Sub

Answer 2

您可以为关联区域Range Name定义Range("B42:J42").Name = "Link"。其余代码是相同的：

Sub PasteOverview()
    With ActiveSheet
        Link = Range("D3")
        Range("B42:J42").Select

        Range("B42:J42").Name = "Link"

        Selection.Copy
        Range("A1").Select
        Sheets("Active").Select
        Cells(Range("B10000").End(xlUp).Row + 1, 2).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        ActiveSheet.Paste Link:=True
        Range("C" & (ActiveCell.Row)).Select
        ActiveSheet.Hyperlinks.Add ActiveCell, "", "Link"
    End With
End Sub

但是，您需要为要链接的所有区域设置唯一的范围名称。表格的不同名称本身可以帮助实现这一目标。

超链接到原始表

2 个答案: