VBA循环遍历表列名称并将数据组合在新工作表中

Question

我在不同的选项卡上有 2 个表，其中有许多具有相同名称的列。我想将这两个表的数据合并到第三个选项卡上的一个新表中。

我尝试了多种方法来做到这一点，例如对列位置（如 A、B、C..）进行硬编码，并在我需要复制和粘贴的 20 个左右的列中手动编码.但是，我宁愿遍历我需要复制的列标题数组的循环，获取数据并附加到第三个表。这样，如果位置移动它会继续工作，我只需要担心列标题。我在使用数组或在 VBA 中使用命名表方面并不是那么先进，所以我希望有人可以帮助我。

例子：

Dim arr1 As Variant
Dim vItm As Variant
Dim tbl1 As ListObject
Dim tbl2 As ListObject
Dim tbl3 As ListObject


arr1 = Array("Header1", "Header2", "Header3")
Set tbl1 = Worksheets("Sheet1").ListObjects("Table1")
Set tbl2 = Worksheets("Sheet2").ListObjects("Table2")
Set tbl3 = Worksheets("Sheet3").ListObjects("Table3")

For Each vItm In arr1

    Set c = tbl2.ListColumns(vItm).DataBodyRange

    If Not c Is Nothing Then
        col = c.Column

          With tbl2.DataBodyRange
            tRows = .Rows.Count
            tCols = .Columns.Count
            Set CopyRng = .Range(.Cells(0, col), .Cells(tRows - 1, col))

          End With

          Set Dest = tbl1.HeaderRowRange.Find(vItm, LookIn:=xlValues, LookAt:=xlWhole, _
            MatchCase:=False, SearchFormat:=False)

          MsgBox Dest.Address

    Else
        MsgBox "Header not found"
        Exit Sub
    End If
Next vItm

对于数组中的每个列标题，请查看表 1 并复制下面的所有数据并粘贴到表 3 中相应的列标题中。对所有数组项执行此操作。然后对于数组中的每个列标题，在 Table2 中查找并复制下面的所有数据，并将 Table3 中来自 Table1 的数据下方的相应列标题粘贴。

在这里感谢任何帮助。谢谢！

Answer 1

我想我已经解决了大部分问题，我引用了正确的表格和数据来复制和移动。我将在我原来的问题中发布完成的代码。但是现在我遇到了一些变量没有正确更新的问题。就像我的 sub 末尾的这段代码一样。我重用了上一节中的 copyrng、lastrow 和 lastcol。当我调试时， lastrow 和 lastcol 显示正确的数字，但复制范围仅选择列 O (#15) 到最后一行。知道是什么原因造成的或如何重置变量吗？

With tbl3.DataBodyRange
CopyRng = .Range(Cells(1, 16), .Cells(lastRow, lastCol))

    With CopyRng
        .Copy
        Debug.Print .Address
        Debug.Print lastCol
    End With

结束