粘贴数据 - Excel 的其他 Listobject 中的 Listobjects 范围

Question

我正在使用 VBA 在 excel (ListObjects) 中的 table 之间移动数据我想避免循环，因为它们太耗时了

我有第一个（出处）tablecalled:tabl1 和第二个来源table：tbl2

我有天命tablecalled:tbl3 这个 table 是空的，所以 databodyrange 什么都不是

我想将来自两个来源 tabletbl1 和 tbl2 的数据粘贴到 tbl3

Dim tbl1 As ListObject
Dim tbl2 As ListObject
Dim tbl3 As ListObject
Set tbl1 = ThisWorkbook.Sheets(1).ListObjects("table1")
Set tbl2 = ThisWorkbook.Sheets(1).ListObjects("table2")
Set tbl3 = ThisWorkbook.Sheets(1).ListObjects("table3")

'delete the data of table 3
If Not tbl3.DataBodyRange Is Nothing Then
    tbl3.DataBodyRange.Delete
End If

'Adding a first row to avoid that databodyrange isnothing
tbl3.ListRows.Add
'this code does not work
'What I try to do is copy the range of column1 of table1 and paste it in the first 
tbl1.ListColumns(1).DataBodyRange.Copy Destination:=tbl3.ListColumns(1).DataBodyRange.Item(1).Address

我不想使用循环（太慢）而且我不想使用“.select”：太容易出错了。

当然，粘贴在table三个中的数据必须是table的一部分。

在这个 link 中，我发布了自己（并回答）了问题的部分解决方案： Excel copy data from several columns of listobject A (tableA) into one column of listobject B (tableB) one after the other

但我真的很想找到一个仅引用列表对象的名称而不是 sheet 中的绝对位置的解决方案（否则移动列表对象会使解决方案无效）。

这里是说明的问题。请注意，为了清楚起见，我将三个 table 放在一个 sheet 中，但 table 分布在不同的 sheet 中。

这是期望的结果：

Answer 1

试试这个：

Dim TBL1 As ListObject
Dim TBL2 As ListObject
Dim TBL3 As ListObject

Set TBL1 = ActiveSheet.ListObjects("TBL_1")
Set TBL2 = ActiveSheet.ListObjects("TBL_2")
Set TBL3 = ActiveSheet.ListObjects("TBL_3")

Dim ZZ As Long

'we clean TBL3 only if there is data
If Range(TBL3.Name & "[" & TBL3.HeaderRowRange(1, 1).Value & "]").Cells(1, 1).Value <> "" Or _
    Range(TBL3.Name & "[" & TBL3.HeaderRowRange(1, 1).Value & "]").Count > 1 Then TBL3.DataBodyRange.Delete


Range(TBL1.Name & "[" & TBL1.HeaderRowRange(1, 1).Value & "]").Copy
Range(TBL3.Name & "[" & TBL3.HeaderRowRange(1, 1).Value & "]").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

Range(TBL1.Name & "[" & TBL1.HeaderRowRange(1, 3).Value & "]").Copy
Range(TBL3.Name & "[" & TBL3.HeaderRowRange(1, 3).Value & "]").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

Range(TBL2.Name & "[" & TBL2.HeaderRowRange(1, 1).Value & "]").Copy

Range(TBL3.Name & "[" & TBL3.HeaderRowRange(1, 1).Value & "]").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

Range(TBL2.Name & "[" & TBL2.HeaderRowRange(1, 3).Value & "]").Copy

Range(TBL3.Name & "[" & TBL3.HeaderRowRange(1, 3).Value & "]").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

'we clean blanks
For ZZ = TBL3.DataBodyRange.Rows.Count To 1 Step -1
    If TBL3.DataBodyRange.Cells(ZZ, 1).Value = "" Then TBL3.ListRows(ZZ).Delete
Next ZZ


Set TBL1 = Nothing
Set TBL2 = Nothing
Set TBL3 = Nothing

代码将Tbl1和Tbl2的第1列和第3列的所有数据粘贴到Tbl3的第1列和第3列。

粘贴后，检查是否有空白，如果是，则删除table的那一行。

我试过这个：

应用代码后，我得到了这个：

请注意，代码还会在粘贴之前删除 TBL3 中的所有数据。

希望您能根据自己的需要进行调整。

粘贴数据 - Excel 的其他 Listobject 中的 Listobjects 范围

Paste data - ranges of Listobjects in other Listobject of Excel

excel

vba

copy

range

listobject