Sub New_Multi_Table_Pivot()    Dim i As Long
    Dim arSQL() As String
    Dim objPivotCache As PivotCache
    Dim objRS As Object
    Dim ResultSheetName As String
    Dim SheetsNames As Variant
 
    'имя листа, куда будет выводиться результирующая сводная
    ResultSheetName = "Сводная"
    'массив имен листов с исходными таблицами
    SheetsNames = Array("Альфа", "Бета", "Гамма", "Дельта")
 
    'формируем кэш по таблицам с листов из SheetsNames
    With ActiveWorkbook
        ReDim arSQL(1 To (UBound(SheetsNames) + 1))
        For i = LBound(SheetsNames) To UBound(SheetsNames)
            arSQL(i + 1) = "SELECT * FROM [" & SheetsNames(i) & "$]"
        Next i
        Set objRS = CreateObject("ADODB.Recordset")
        objRS.Open Join$(arSQL, " UNION ALL "), _
                   Join$(Array("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=", _
                               .FullName, ";Extended Properties=""Excel 8.0;"""), vbNullString)
    End With
 
    'создаем заново лист для вывода результирующей сводной таблицы
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets(ResultSheetName).Delete
    Set wsPivot = Worksheets.Add
    wsPivot.Name = ResultSheetName
 
    'выводим на этот лист сводную по сформированному кэшу
    Set objPivotCache = ActiveWorkbook.PivotCaches.Add(xlExternal)
    Set objPivotCache.Recordset = objRS
    Set objRS = Nothing
    With wsPivot
        objPivotCache.CreatePivotTable TableDestination:=wsPivot.Range("A3")
        Set objPivotCache = Nothing
        Range("A3").Select
    End With
 
End Sub