Build a pivot table from more than one Excel Worksheet

As you may know, all versions of excel before 2007 have a limit of 65536 rows in a single worksheet. If you have very large data sets that you need to generate into a pivot table this can be a very limiting factor. Lets say that you needed to analyse products over 20 weeks. To uniquely identify a product and week you would need to use one line per product per week. 65500 / 20 = 3275 products which is not really that many.

In order to get round this, you would normally have to set the source of the pivot table data to be something other than a worksheet and use Microsoft Query to get the data from a database or another workbook. If you do not have Microsoft Query installed there is a way to generate a single pivot table from multiple worksheets using VBA. A shout out goes to Jon von der Heyden on the mrExcel message boards for providing me with this script.

http://www.mrexcel.com/forum/showthread.php?t=528875

Public Sub ConsolidateAndPivot()
Dim rngCell As Range, strRange As String, rngData As Range
Dim pvc As PivotCache, pvt As PivotTable
Dim arrSheets As Variant, wks As Worksheet
Dim recData As ADOR.Recordset

Set recData = New ADOR.Recordset
arrSheets = Array("Sheet1", "Sheet2", "Sheet3")
strRange = "A:E"
Set pvt = Sheets(1).PivotTables(1)

For Each wks In Sheets(arrSheets)
Set rngData = Intersect(wks.Range(strRange), wks.UsedRange)
If wks.Name = arrSheets(0) Then
For Each rngCell In rngData.Resize(1)
With recData
With .Fields
Select Case TypeName(rngCell.Offset(1).Value)
Case "String"
.Append rngCell.Text, adVarChar, 255
Case "Date"
.Append rngCell.Text, adDate
Case "Double", "Currency"
.Append rngCell.Text, adDouble
End Select
End With
End With
Next rngCell
End If
If recData.State = 0 Then recData.Open
Set rngData = Intersect(rngData.Offset(1), wks.UsedRange)
For Each rngCell In rngData
With recData
If rngData(0, rngCell.Column).Text = .Fields(0).Name Then .AddNew
.Fields(rngData(0, rngCell.Column).Text).Value = rngCell.Value
.Update
End With
Next rngCell
Next wks

With Sheets.Add(Sheets(1))
Set pvc = ThisWorkbook.PivotCaches.Add(SourceType:=xlExternal)
Set pvc.Recordset = recData
With pvc.CreatePivotTable(TableDestination:=.Range("A1"))
pvt.CacheIndex = .CacheIndex
End With
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With

recData.Close
Set recData = Nothing
End Sub

This builds a pivot cache from data in the worksheets named in the arrSheets array, using the columns defined in strRange. It will use the data to populate a pivot table already defined in Sheet(1). If you dont already have a pivot table or you want to add it to a new worksheet, you will need to create the sheet and table as part of the script.

WARNING! This may be slow and should only be used as a last resort. It is much more efficient to get the data from a database or text file or another workbook if possible.