Вставить данные - диапазоны списочных объектов в другие списочные объекты Excel

Question

Я использую VBA для перемещения данных между таблицами в Excel (ListObjects) И я хочу избежать циклов, потому что они слишком много времени

У меня есть первая (origin) таблица, которая называется: tabl1 и secondисходная таблица: tbl2

У меня есть таблица судьбы с именем: tbl3 эта таблица пуста, поэтому databodyrange - ничто

Я хотел бы вставить данные из двух исходных таблиц tbl1 и 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": слишком подвержен ошибкам.

И, конечно, данные, вставленные в таблицу тридолжен быть частью таблицы.

В этой ссылке я опубликовал (и ответил) частичное решение проблемы: Excel скопирует данные из нескольких столбцов объекта A (таблицы A) в один столбецсписок объектов B (таблица B) один за другим

, но мне бы очень хотелось найти решение, относящееся только к названию объектов списка, а не к абсолютным позициям на листе (в противном случае перемещение объекта спискаЯ сделаю недействительным решение).

Вот проблема, проиллюстрированная.Помните, что я поместил три таблицы в один лист для ясности, но таблицы распределены по разным листам.

Это желаемый результат:

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

Код вставляет все данные в столбцах 1 и 3 столбцов Tbl1 и Tbl2 в столбцы 1 и 3 столбца Tbl3.

После вставки он проверяет, есть лиявляется пустым, и если true, то удаляет эту строку таблицы.

Я пытался с этим:

Ипосле применения кода я получаю следующее:

Обратите внимание, что код также удаляет ВСЕ данные в TBL3 перед вставкой .

Надеюсь, вы сможете адаптировать это к вашим потребностям.