Добрый день! В приемах есть отличный пример как из нескольких листов сделать одну сводную таблицу. Проблема в том что макрос перебирает листы и не выбирает весь массив данных (делает это как то произвольно!) можно это исправить? ссылка по теме http://www.planetaexcel.ru/tip.php?aid=233
рабочий макрос от Романа 22.03.2011 Я не знаю где искать проблему. PS файл не выкладываю...> 100mb
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 String Dim sh As Integer
ResultSheetName = ActiveSheet.Name
For sh = 2 To ActiveWorkbook.Sheets.Count SheetsNames = SheetsNames & "SELECT * FROM [" & Sheets (sh).Name & "$] UNION ALL " Next sh SheetsNames = Trim(SheetsNames) SheetsNames = Left(SheetsNames, Len(SheetsNames) - 10)
With ActiveWorkbook Set objRS = CreateObject("ADODB.Recordset") objRS.Open SheetsNames, _ 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