How to copy multiple tables in one workbook to a new workbook using VBA?

Question

I've been trying different variation of codes from online research, but none seems to work. The most recent code I tried is as below:

Sub Export_AllStates()

Dim TableArray As Variant

TableArray = Array("StateA[#All]", "StateB[#All]", "StateC[#All]")

    For x = LBound(TableArray) To UBound(TableArray)
        Set tbl = ThisWorkbook.Worksheets(x).ListObjects(TableArray(x)).Range
        tbl.Copy
        
        Workbooks.Add
        ActiveSheet.Paste
        ActiveWorkbook.SaveAs Filename:="All States.csv"
    
    Next x

End Sub

What I'm trying to accomplish is to combine multiple tables (in this example, three) and have the output copied to a new single table in a new workbook. I have not gotten to the part where I can copy only the column header once, as they are the same for all the tables. Any addition to the code for this requirement would be appreciated too.

I hope I made sense, and I appreciate any feedback I can get.

Thank you.

EDIT: Should have mentioned earlier, the error I get when running this code is "Run-time error '9': Subscript out of range" - referencing the Set tbl line

If the column headers are all the same, then just copy the headers once, then copy the `DataBodyRange` of each table. I think you can drop the `[#All]` from each table name. — BigBen, Jun 25 '20 at 15:24
What happens when you drop the `[#All]` from each table name? — BigBen, Jun 25 '20 at 16:45
That most likely means that the order of your table names in the array is not the same order as the worksheets containing those tables that you're looping over. Do you only have one table on each sheet? — BigBen, Jun 25 '20 at 16:59
All the tables are in one sheet. The tables are results of Power Query and expected to be refreshed from time to time. Wasn't sure if that matter, sorry. — Shan Paramaguru, Jun 25 '20 at 17:02
Then `Set tbl = ThisWorkbook.Worksheets("yoursheetname").ListObjects(TableArray(x)).Range`... don't use `x` within `Worksheets`. — BigBen, Jun 25 '20 at 17:04
OK, that "resolved" the initial error, but now I realize that the rest of the code is trying to paste each table into a new workbook on it's own (creating a new workbook for each table); instead of pasting all into one. — Shan Paramaguru, Jun 25 '20 at 17:24
Right, because you are creating a new workbook *inside* the loop, when it should be done *outside* the loop. — BigBen, Jun 25 '20 at 17:25
Ah got it. I moved the codes to add workbook, paste and save file to outside of the loop. It appears to only paste the latest table in the array. Sorry to be asking so much, still learning to use vba effectively. Thanks for all the help so far! — Shan Paramaguru, Jun 25 '20 at 17:35
Instead of `ActiveSheet.Paste`, [find the last row](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-excel-with-vba) and then paste in the next row after it. — BigBen, Jun 25 '20 at 17:41

score 0 · Answer 1 · answered Jun 25 '20 at 16:35

You use ThisWorkbook(means the Current workbook) which is problematic here. the "Workbooks.Add" create a new workbook and become the active workbook. So when you look for tbl in that new Workbook you cannot find any.

You can try something below :

Sub Export_AllStates()
  Dim wb as Workbook
  Dim TableArray As Variant
  Set wb as ActiveWorkbook
  TableArray = Array("StateA[#All]", "StateB[#All]", "StateC[#All]")

  For x = LBound(TableArray) To UBound(TableArray)
      Set tbl = wb.Worksheets(x).ListObjects(TableArray(x)).Range
      tbl.Copy
    
      Workbooks.Add
      ActiveSheet.Paste
      ActiveWorkbook.SaveAs Filename:="All States.csv"
  Next x
End Sub

About making an even better loop, you should look there : https://www.thespreadsheetguru.com/the-code-vault/2014/12/12/loop-through-all-tables-in-excel-workbook-or-worksheet

Bye !

The use of `ThisWorkbook` is perfectly fine. I'm afraid the problem is something else. — BigBen, Jun 25 '20 at 16:40
Tried the recommended code, unfortunately the same error at the same line ("Set tbl...") — Shan Paramaguru, Jun 25 '20 at 17:01

score 0 · Answer 2 · answered Jun 26 '20 at 20:54

With the help of a colleague, I managed to get the output that I needed. Although, it was more complicated (with extra codes) than I thought it would take. Posting it here in case anyone might find it useful. It involves creating an array, reversing the column vs row and transpose back when adding to new workbook. I'm new at this, so pardon me if the lingo is not quite right here.

'''' Sub Export_AllStates()

Dim TableArray As Variant
Dim ArrayToPaste As Variant
ReDim ArrayToPaste(1 To 5, 1 To 1)
Dim i As Long: i = 1
Dim r As Long, c As Long

TableArray = Array("StateA", "StateB", "StateC")

'Create Header Row
ArrayToPaste(1, 1) = "Customer#"
ArrayToPaste(2, 1) = "First Name"
ArrayToPaste(3, 1) = "Last Name"
ArrayToPaste(4, 1) = "Email"
ArrayToPaste(5, 1) = "Home State"

For x = LBound(TableArray) To UBound(TableArray)

    Set tbl = ThisWorkbook.Worksheets("Sheet1").ListObjects(TableArray(x))
    For r = 1 To tbl.DataBodyRange.Rows.Count
        i = i + 1
        ReDim Preserve ArrayToPaste(1 To 5, 1 To i)
        For c = 1 To 5
            ArrayToPaste(c, i) = tbl.DataBodyRange(r, c)
        Next c
    Next r
    
Next x

Dim ArrTrans As Variant
ArrTran = Application.Transpose(ArrayToPaste)

    Workbooks.Add
        With ActiveSheet
            Dim rng As Range
            Set rng = .Range(.Cells(1, 1), .Cells(UBound(ArrTran) - 1, 5))
            rng = ArrTran
        End With
    
        ActiveWorkbook.SaveAs Filename:="All States.csv"

End Sub ''''

How to copy multiple tables in one workbook to a new workbook using VBA?

2 Answers2