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

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中相应的列标题。对所有数组项都这样做。然后，对于数组中的每个列标题，查看表2，复制下面的所有数据，并将表3中对应的列标题粘贴到表1数据的下面。

感谢任何帮助。谢谢!

Answer 1

我想我已经解决了我的大多数问题引用正确的表和数据复制和移动。我将在我原来的问题中发布完成的代码。然而，现在我有一些变量没有正确更新的问题。就像我的子代码末尾的这段代码一样。我重用了上一节中的copyng、lastrow和lastcol。当我调试时，lastrow和lastcol显示了正确的数字，但是复制范围只选择0列(#15)直到最后一行。任何想法是什么导致这或如何重置变量?

With tbl3.DataBodyRange
CopyRng = .Range(Cells(1, 16), .Cells(lastRow, lastCol))
    With CopyRng
        .Copy
        Debug.Print .Address
        Debug.Print lastCol
    End With

最后