excel - 将主表中的多个表与属性（函数）结合起来

Question

我正在尝试使用对象和宏组合多个表。

我发现将多个表行合并到主表
中，这里提出了一个有效的代码片段。

我的问题是我在单元格（函数）中有超链接。当我使用宏组合表格时，不会传输超链接。

如何修改代码以同时传输超链接？

我想到了类似的东西：

Intersect(loDest.ListColumns(lc.Name).Range.EntireColumn, rDest).Hyperlinks = loDest.ListColumns(lc.Name).Range.EntireColumn.Hyperlinks(1).Address

这是来自 jeffreyweir 的代码：

Sub CombineTables(loDest As ListObject, Optional lcSource As ListColumn)

Dim ws              As Worksheet
Dim lo              As ListObject
Dim lc              As ListColumn
Dim rDest           As Range
Dim lDestRows       As Long
Dim lSourceRows     As Long

Application.ScreenUpdating = False

If lcSource Is Nothing Then Set lcSource = loDest.ListColumns(1)
If loDest.ListRows.Count > 0 Then loDest.DataBodyRange.Delete

For Each ws In ActiveWorkbook.Worksheets
    For Each lo In ws.ListObjects
        If lo <> loDest Then
            With lo
                If InStr(.Name, loDest.Name & "_") > 0 Then
                    On Error Resume Next
                    lDestRows = loDest.ListRows.Count
                    On Error GoTo 0
                    lSourceRows = .ListRows.Count
                    If lSourceRows > 0 Then

                        'Work out where we want to paste the data to
                        Set rDest = loDest.HeaderRowRange.Offset(1 + lDestRows).Resize(lSourceRows)

                        'Resize the destination table
                        loDest.Resize loDest.Range.Resize(1 + lSourceRows + lDestRows)       

                        For Each lc In .ListColumns
                         Intersect(loDest.ListColumns(lc.Name).Range.EntireColumn, rDest).Value2 = lc.DataBodyRange.Value
                        Next lc
                        Set lc = Nothing
                        On Error Resume Next
                        Set lc = .ListColumns(lcSource.Name)
                        On Error GoTo 0
                        If lc Is Nothing Then Intersect(lcSource.Range, rDest.EntireRow).Value2 = ws.Name
                    End If
                End If
            End With
        End If
    Next lo
Next ws

Application.ScreenUpdating = True

End Sub

呼叫者：

Sub CombineTables_Caller()
CombineTables [SomeName].ListObject, [SomeName].ListObject.ListColumns("Source")
End Sub

标签： excelvba