Sub 全テーブルを縦結合する()
    Dim ws As Worksheet
    Dim lo As ListObject
    Dim mCode As Variant
    Dim formulaText As String
    Dim tableNames As String
    Dim newTable As ListObject

    Set ws = ActiveSheet

    For Each lo In ws.ListObjects
        tableNames = tableNames & """" & lo.Name & ""","
    Next lo

    tableNames = Left(tableNames, Len(tableNames) - 1)

    mCode = Array( _
        "let", _
        "    テーブル名リスト = {" & tableNames & "},", _
        "    ソース = Excel.CurrentWorkbook(),", _
        "    対象テーブル = Table.SelectRows(", _
        "        ソース,", _
        "        each List.Contains(テーブル名リスト, [Name])", _
        "    ),", _
        "    加工済みテーブル = Table.AddColumn(", _
        "        対象テーブル,", _
        "        ""結合データ"",", _
        "        each", _
        "            let", _
        "                元テーブル名 = [Name],", _
        "                必要列 = Table.SelectColumns([Content], {""社員"", ""番号""}),", _
        "                テーブル名追加 = Table.AddColumn(必要列, ""元テーブル名"", each 元テーブル名)", _
        "            in", _
        "                テーブル名追加", _
        "    ),", _
        "    縦結合 = Table.Combine(加工済みテーブル[結合データ])", _
        "in", _
        "    縦結合" _
    )

    formulaText = Join(mCode, vbCrLf)

    On Error Resume Next
    ThisWorkbook.Queries("全テーブル結合").Delete
    On Error GoTo 0

    ThisWorkbook.Queries.Add _
        Name:="全テーブル結合", _
        Formula:=formulaText

    Set newTable = ws.ListObjects.Add( _
        SourceType:=0, _
        Source:= _
            "OLEDB;Provider=Microsoft.Mashup.OleDb.1;" & _
            "Data Source=$Workbook$;" & _
            "Location=""全テーブル結合"";", _
        Destination:=ws.Range("E2") _
    )

    With newTable

        .Name = "T_全テーブル結合"

        With .QueryTable
            .CommandType = xlCmdSql
            .CommandText = Array("SELECT * FROM [全テーブル結合]")
            .Refresh BackgroundQuery:=False
        End With

    End With

    ThisWorkbook.Queries("全テーブル結合").Delete
End Sub


