Solving listobject paste special - Run time error 1004

Question

I would like to move all of the data from one table into 4 other tables. I am getting a pastespecial error using the code below. The code is quite long so a relevant snippet is posted below.

Set tbl2 = ws1.ListObjects("Table2")
Set tbl3 = ws2.ListObjects("Table3")
Set tbl4 = ws3.ListObjects("Table4")
Set tbl5 = ws4.ListObjects("Table5")

For i = 1 To tbl1.ListRows.Count
    tbl1.ListRows(i).Range.Copy

    tbl2.ListRows.Add 1, True
    tbl2.ListRows(1).Range.PasteSpecial xlPasteFormats
    tbl2.ListRows(1).Range.Value = tbl1.ListRows(i).Range.Value

    tbl3.ListRows.Add 1, True
    tbl3.ListRows(1).Range.PasteSpecial xlPasteFormats
    tbl3.ListRows(1).Range.Value = tbl1.ListRows(i).Range.Value


    tbl4.ListRows.Add 1, True
    tbl4.ListRows(1).Range.PasteSpecial xlPasteFormats
    tbl4.ListRows(1).Range.Value = tbl1.ListRows(i).Range.Value

    tbl5.ListRows.Add 1, True
    tbl5.ListRows(1).Range.PasteSpecial xlPasteFormats
    tbl5.ListRows(1).Range.Value = tbl1.ListRows(i).Range.Value

Next i

"Run time error 1004": Pastespecial of range class failed

This error is triggered by the first paste special line.

Any ideas on how to correct this issue? I have searched on stacked for a while but have not yet found a solution.

Thanks!

Answer 1

Seems you're simply appending the contents of tbl1 to a bunch of other tables.

Instead of involving the clipboard, copy the source DataBodyRange to a 2D variant array:

Dim content As Variant
content = tbl1.DataBodyRange.Value

Then add a new row to your destination:

tbl2.ListRows.Add

And dump your 2D array at that location:

tbl2.ListRows(tbl2.ListRows.Count).Range.Resize(UBound(content, 1)).Value = content

Rinse & repeat for every destination table... should be pretty much instant.