Excel VBA 代码用公式链接单元格填充汇总表

Question

我正在尝试创建一个汇总表，其中将有 46 行数据，超过 7 列。因此，我将从 46 张表格中提取数据，并将有 7 个不同的数据点。

我可以使用偏移函数来简化此代码吗？例如

Sub AutoFillSheetNames()
    Dim ActRng As Range
    Dim ActWsName As String
    Dim ActAddress As String
    Dim Ws As Worksheet

    On Error Resume Next

    Set ActRng = Application.ActiveCell
    ActWsName = Application.ActiveSheet.Name
    ActAddress = ActRng.Address(False, False)

    Application.ScreenUpdating = False

    xIndex = 0
    For Each Ws In Application.Worksheets
        If Ws.Name <> ActWsName Then
            ActRng.Offset(xIndex, 0).Value = "='" & Ws.Name & "'!" & ActAddress
            xIndex = xIndex + 1
        End If
    Next

    Application.ScreenUpdating = True
End Sub

我想链接实际的单元格，以便它们可以自动更新，并且需要 VBA，因为它将为许多具有不同选项卡名的不同 Excel 工作簿完成。例如，当我将摘要表上的单元格 F2 链接到 48 张表的第一张表上的 F2 时，此处发布的代码有效，然后将剩余 47 个单元格的公式正确输入到 F48。但是，当我想将摘要表上的单元格 H2 链接到第一表上的 G7 时，我应该在上面的代码中进行哪些更改？

Answer 1

我真的不明白你想要完成什么。下面的代码将链接摘要表中每个工作表的第一行中的 7 个单元格（即 A1:G1）。将有与表格一样多的行。但我不知道这是否是你真正想要的。

Sub AutoFillSheetNames()
    Dim CurrWorkBK As Workbook
    Dim CurrSheet As Worksheet
    Dim TheOtherSheets As Worksheet
    Dim MyRow As Long
    Dim MyCol As Long

    Set CurrWorkBK = ThisWorkbook
    Set CurrSheet = CurrWorkBK.Worksheets("Summary")

    MyRow = 1
    For Each TheOtherSheets In CurrWorkBK.Worksheets
        If TheOtherSheets.Name <> CurrSheet.Name Then
            For MyCol = 1 To 7
                CurrSheet.Cells(MyRow, MyCol).Value = "='" & TheOtherSheets.Name & "'!" & TheOtherSheets.Cells(1, MyCol).Address
            Next MyCol
            MyRow = MyRow + 1
        End If
    Next
End Sub