Добрый день!  
 
Помогите, пож-та, не могу понять почему макрос не работает в 2010 EXCEL, что нужно заменить, чтобы заработал.  
Очень буду благодарна  
 
 
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("FAB", "SIG")  
   
   'формируем кэш по таблицам с листов из 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