VBA Copying data from one table to another and rearranging columns

Question

I have 99 columns in one table called tbl_raw. I need to copy 96 of those columns into another table with the same exact header names, but they are rearranged in a different order. What is the most efficient way to do this?

The only way I knew was:

raw_data.Range("tbl_raw[EMPLOYEE]").Copy processed_data.Range("tbl_processed[EMPLOYEE]").PasteSpecial

However, this would take a lot of code (96 * 2 = 192 lines) and I wasn't sure if there was a more efficient way to do it.

I tried to use https://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables, but I couldn't figure out a way to do it with that information either.

Any guidance would be greatly appreciated.

Answer 1

Avoid dealing with copying ListObject columns and use a direct value transfer.

Option Explicit

Sub raw2processed()

    Dim lc As Long, mc As Variant, x As Variant
    Dim raw_data As Worksheet, processed_data As Worksheet
    Dim raw_tbl As ListObject, processed_tbl As ListObject

    Set raw_data = Worksheets("raw")
    Set processed_data = Worksheets("processed")
    Set raw_tbl = raw_data.ListObjects("tbl_raw")
    Set processed_tbl = processed_data.ListObjects("tbl_processed")

    With processed_tbl
        'clear target table
        On Error Resume Next
        .DataBodyRange.Clear
        .Resize .Range.Resize(raw_tbl.ListRows.Count + 1, .ListColumns.Count)
        On Error GoTo 0

        'loop through target header and collect columns from raw_tbl
        For lc = 1 To .ListColumns.Count
            Debug.Print .HeaderRowRange(lc)
            mc = Application.Match(.HeaderRowRange(lc), raw_tbl.HeaderRowRange, 0)
            If Not IsError(mc) Then
                x = raw_tbl.ListColumns(mc).DataBodyRange.Value
                .ListColumns(lc).DataBodyRange = x
            End If
        Next lc

    End With

End Sub