Paste data - ranges of Listobjects in other Listobject of Excel

Question

I am using VBA to move data between tables in excel (ListObjects) And I want to avoid loops for they are too much time consuming

I have a first (origin) table called:tabl1 and a second origin table: tbl2

I have a destiny table called:tbl3 this table is empty, so databodyrange is nothing

I would like to paste data from the two origin tables tbl1 and tbl2 into 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

I dont want to use loop (too slow) And I dont want to use ".select": too error-prone.

And of course, the data pasted in table three has to be part of the table.

In this link I posted myself (and answered) a partial solution to the problem: Excel copy data from several columns of listobject A (tableA) into one column of listobject B (tableB) one after the other

but I would really like to find a solution referring only to the name of listobjects and not to absolute positions in a sheet (otherwise moving the listobject would invalidate the solution).

Here is the problem illustrated. Be aware that I put the three tables in one sheet for clarity purposes but the tables are distributed in different sheets.

This is the desired result:

Foxfire And Burns And Burns · Accepted Answer · 2018-10-10 09:33:13Z

1

Try this:

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

The code pastes all data in Column 1 and 3 of Tbl1 and Tbl2 into column 1 and 3 of Tbl3.

After pasting, it checks if there is any blank, and if true, then it deletes that row of the table.

I tried with this:

And after applying code, I get this:

Please, note that the code also deletes ALL data in TBL3 before pasting.

Hope you can adap this to your needs.

edited Oct 10, 2018 at 9:33

answered Oct 10, 2018 at 9:24

Foxfire And Burns And Burns

12.1k2 gold badges19 silver badges42 bronze badges

Sign up to request clarification or add additional context in comments.

7 Comments

JFerro Over a year ago

First try I get and Error "Range' of object?_global' failed

Foxfire And Burns And Burns Over a year ago

Which line? Make sure you change the table names to the table names you got

JFerro Over a year ago

The names do not change since: Set tbl3 = ThisWorkbook.Sheets(1).ListObjects("table3") if I do: MsgBox tbl3.HeaderRowRange(1, 1).Value that gives "name" which puzzels me. I am trying to understand what is actually the following doing: Range(tbl3.Name & "[" & tbl3.HeaderRowRange(1, 1).Value & "]").cells(1,1).value it is the value of the first cell of a range. What is that range? It is a bit confusing because the content of the first cell of your header is "name" and tbl3.name is the name of the table itself.

JFerro Over a year ago

ABSOLUTLY IMPORTANT FROM FOXIFIRE ANSWER: see how when pasting the second table he uses End(xlDown).Offset(1, 0) this moves the range cell down and offsets it one value down in order not to copy over the last name added.

JFerro Over a year ago

Another key point: Notice how what is inside the Range(...) its actually a string, so you can build the strings with the names of columns dinamically. like myNamesRange= TBL1.Name & "[names]" and then do range(myNamesRang). it works!!!

|

Collectives™ on Stack Overflow

Paste data - ranges of Listobjects in other Listobject of Excel

1 Answer 1

7 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

7 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related