Option Explicit

Public Sub CreatePivotTable()
    Dim rst As ADODB.Recordset
    Dim cn As ADODB.Connection
    Dim strConnection As String
    Dim strSQL As String
    Dim ptbl As PivotTable
    Dim pch As PivotCache
    Dim sht As Worksheet
    
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "User ID=Admin;" & _
                    "Data Source='" & ThisWorkbook.FullName & "';" & _
                    "Mode=Read;" & _
                    "Extended Properties=""Excel 12.0 Macro;"";"
                    
    strSQL = _
            "SELECT * FROM [Лист1$] " & _
            "IN '" & ThisWorkbook.Path & "\Книга1.xlsx' " & _
            "[Excel 12.0;Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Extended Properties='HDR=YES;'] " & _
            "UNION ALL " & _
            "SELECT * FROM [Лист1$] " & _
            "IN '" & ThisWorkbook.Path & "\Книга2.xlsx' " & _
            "[Excel 12.0;Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Extended Properties='HDR=YES;'] " & _
            "UNION ALL " & _
            "SELECT * FROM [Лист1$] " & _
            "IN '" & ThisWorkbook.Path & "\Книга3.xlsx' " & _
            "[Excel 12.0;Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Extended Properties='HDR=YES;']"
        

    Set cn = New ADODB.Connection
    cn.Open strConnection
    Set rst = cn.Execute(strSQL)
    
    Set sht = ThisWorkbook.Worksheets.Add
    
    Set pch = ThisWorkbook.PivotCaches.Create(xlExternal)
    Set pch.Recordset = rst
    Set ptbl = pch.CreatePivotTable(sht.Range("A1"), "СводТаб_" & sht.Name)
'    ptbl.HasAutoFormat = True 'Это подгонит столбцы после перестройки до нужной ширины
    
    ptbl.AddDataField ptbl.PivotFields("Quantity"), "Количество", xlSum
    
    'Поместим поле "id" в область строк сводной таблицы
    With ptbl.PivotFields("id")
        .Orientation = xlRowField
        .Position = 1
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)  'Не выводить итоги по полю
    End With

    'Поместим поле "Title" в область фильтров сводной таблицы
    With ptbl.PivotFields("Title")
        .Orientation = xlPageField
        .Position = 1
    End With

    rst.Close: Set rst = Nothing
    cn.Close: Set cn = Nothing
    
End Sub