Option Explicit
Option Base 1
Sub PivotReport()
Dim pc As PivotCache
Dim pt As PivotTable
Dim lngPivots As Long
Dim lngPosition As Long
Dim wks As Worksheet
Dim varSettings As Variant
Dim bWorksheetExists As Boolean
Dim wksOutput As Worksheet
Dim rngOutput As Range
Dim loOutput As ListObject
' The purpose of lngPosition? I don't want to hard-code the array position of each element at this early development stage.
' So I just increment a counter, which means I can move these headings around, and as long as the correstponding
' code that records the actual attributes is in the same order, I don't have to renumber the array elements
' any time I make a change.
lngPosition = 1
ReDim varSettings(14, 1)
varSettings(lngPosition, 1) = "Pivot Name"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "Worksheet"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "Worksheet Protected?"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "CacheIndex"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "Pivot Address"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "RowGrand"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "ColumnGrand"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "MissingItemsLimit"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "RecordCount"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "MemoryUsed (kB)"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "SaveData"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "EnableRefresh"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "SourceData"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "EnableDrilldown"
lngPosition = lngPosition + 1
lngPivots = 1
For Each wks In ActiveWorkbook.Worksheets
    For Each pt In wks.PivotTables
        lngPosition = 1
        lngPivots = lngPivots + 1
        ReDim Preserve varSettings(14, lngPivots)
       
        With pt
            varSettings(lngPosition, lngPivots) = .Name
            lngPosition = lngPosition + 1
            varSettings(lngPosition, lngPivots) = wks.Name
            lngPosition = lngPosition + 1
            varSettings(lngPosition, lngPivots) = wks.ProtectContents
            lngPosition = lngPosition + 1
            varSettings(lngPosition, lngPivots) = .CacheIndex
            lngPosition = lngPosition + 1
            varSettings(lngPosition, lngPivots) = .TableRange2.Address
            lngPosition = lngPosition + 1
            varSettings(lngPosition, lngPivots) = .RowGrand
            lngPosition = lngPosition + 1
            varSettings(lngPosition, lngPivots) = .ColumnGrand
            lngPosition = lngPosition + 1
            varSettings(lngPosition, lngPivots) = .PivotCache.MissingItemsLimit
            lngPosition = lngPosition + 1
            varSettings(lngPosition, lngPivots) = .PivotCache.RecordCount
            lngPosition = lngPosition + 1
            varSettings(lngPosition, lngPivots) = .PivotCache.MemoryUsed / 1000
            lngPosition = lngPosition + 1
            varSettings(lngPosition, lngPivots) = .SaveData
            lngPosition = lngPosition + 1
            varSettings(lngPosition, lngPivots) = .PivotCache.EnableRefresh
            lngPosition = lngPosition + 1
            varSettings(lngPosition, lngPivots) = .SourceData
            lngPosition = lngPosition + 1
            varSettings(lngPosition, lngPivots) = .EnableDrilldown
            lngPosition = lngPosition + 1
       
        End With
    Next pt
Next wks
'Create a worksheet to dump the output into
Set wksOutput = Sheets.Add
Set rngOutput = Range("A1").Resize(UBound(varSettings, 2), UBound(varSettings, 1))
rngOutput.Value = Application.Transpose(varSettings)
Set loOutput = wksOutput.ListObjects.Add(xlSrcRange, rngOutput, , xlYes)
End Sub