Any advice on Append / Merge Power query using VBA

[juzzie]

Hello. I'm trying to automate Append Power query using VBA to combine (append) three tables from different sheets in the same workbook. My application assumes that users will be adding new tables as needed. So I cannot just hardcode the table names.

My code (see below) cycles thru the worksheets and generates a list of tables using array function. It writes the result into the “L” column of Sheet1. The I grab that range of values and convert it into the format {Table1, Table2, Table3} using TextJoin function. The problem appears when I ty to pass the string to the Append query, using code

ActiveWorkbook.Queries.Add Name:="Append1", Formula:= _

"let" & Chr(13) & "" & Chr(10) & " Source = Table.Combine(""" & listtables & """)" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " Source"

it attaches extra quotation marks in the output around. The result in Power query will look

let

Source = Table.Combine("{table1, table2, table3}")

in

Source

This is almost good, but the quotation marks need to be removed. When I remove those from Power query editor, it combines tables just fine. But I don’t want to do it manually every time I run the code.

If I try to remove the quotes from the formula around listatbles (Table.Combine(listtables)) , the result in power query will look much worse:

let

Source = Table.Combine(listtables)

in

Source

Apparently the Append query expects list of tables in some other type of data. I got stuck here. Let me know if you have some suggestions. Thanks.

My code:

Sub get_tables_append()                                        ' get all tables in an array and make Append Query

   Dim i As Long, j As Long
   Dim Ws As Worksheet
   Dim Tbl As ListObject
   Dim cell As Range
   Dim val() As Variant
   Dim k As Integer
   Dim listtables As String
   Dim wb As Workbook
   
   Set wb = ActiveWorkbook
         
   i = 1: j = 1
   For Each Ws In ActiveWorkbook.Worksheets
   i = i + 1
   
      For Each Tbl In Ws.ListObjects
         j = j + 1
         Cells(j, 12).Resize(, 1) = Array(Tbl.Name)
         
      Next Tbl
   Next Ws
   
  '*************************************** convert an array to a single string
   
   k = 0

For Each cell In Range("L2:L3000")
   
    ReDim Preserve val(0 To k) As Variant 'must resize array to fit number of items
    val(k) = cell.Value
    If cell.Value <> "" Then
    k = k + 1 'increment i to move to next position
    Else: Exit For
    End If
    
Next cell

listtables = "{" & WorksheetFunction.TextJoin(", ", True, val) & "}"

'************************ append query

ActiveWorkbook.Queries.Add Name:="Append1", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Table.Combine(""" & listtables & """)" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    Source"
    
    wb.Connections.Add2 "Query - Append1", _
        "Connection to the 'Append1' query in the workbook.", _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Append1;Extended Properties=""""" _
        , "SELECT * FROM [Append1]", 2
 
End Sub