Way to automatically expand all pivot tables in a notebook?

Hi byte99

Not my best work but something like this.  You could either put this code in your personal macro workbook (and assign a short cut key, or assign it to Quick Access Toolbar button) for repeated use.   Or (simpler to start with)  press Alt F11 on your Pivot Table file and paste this code into the Workbook window

Sub ExpandAll()

Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim iFieldCount As Long
Dim iPosition As Long
Dim sh As Worksheet
Dim wkbkTarget As Workbook


Application.ScreenUpdating = False

Set wkbkTarget = ActiveWorkbook

For Each sh In wkbkTarget.Worksheets

        'If there is any pivot table on the sheet
        If sh.PivotTables.Count > 0 Then
    
    
    
        sh.Activate
       
      
        
       'Expand the lowest position field in the Rows area
'that is currently expanded (showing details)
 For Each pt In sh.PivotTables
        
               
        
           

  'Create reference to 1st pivot table on sheet
  'Can be changed to reference a specific sheet or pivot table.
 ' Set pt = ActiveSheet.PivotTables(1)

  'Count fields in Rows area minus 1 (last field can't be expanded)
  iFieldCount = pt.RowFields.Count - 1
  
  'Loop by position of field
  For iPosition = 1 To iFieldCount
    'Loop fields in Rows area
    For Each pf In pt.RowFields
      'If position matches first loop variable then
      If pf.Position = iPosition Then
        'Loop each pivot item
        For Each pi In pf.PivotItems
          'If pivot item is collapsed then
          If pi.ShowDetail = False Then
            'Expand entire field
            pf.ShowDetail = True
            'Exit the loop
            GoTo NextPT
          End If
        Next pi
      End If
    Next pf
  'If the Exit Sub line is not hit then the
  'loop will continue to the next field position
  Next iPosition
  
NextPT:
  
  Next pt
           
           End If
            Next sh
            
    Set wkbkTarget = Nothing
        
   Application.ScreenUpdating = True
   
End Sub