VBA Code to Collapse and Expand columns

VBA Code to Collapse and Expand columns based on the given criteria:


Sub Collapse_Expand()
Dim w As Worksheet
Dim pt As PivotTable
Dim FinYear As String
Dim QTD As String

FinYear = "FY" & Right(Date, 2)
QTD = "Q3                             "
        
        For Each w In ThisWorkbook.Worksheets
            If ActiveSheet.Name = "Sheet1" Or ActiveSheet.Name = "Sheet2" Then
                ActiveSheet.PivotTables("PivotTable1").PivotFields("Rev_Cost").ShowDetail = False
                ActiveSheet.PivotTables("PivotTable1").PivotFields("Quarter").ShowDetail = False
                ActiveSheet.PivotTables("PivotTable1").PivotFields("Year").ShowDetail = False
                
                ActiveSheet.PivotTables("PivotTable1").PivotFields("Rev_Cost").PivotItems("Rev").ShowDetail = True
                ActiveSheet.PivotTables("PivotTable1").PivotFields("Rev_Cost").PivotItems("Cost").ShowDetail = True
                ActiveSheet.PivotTables("PivotTable1").PivotFields("Year").PivotItems(FinYear).ShowDetail = True
                ActiveSheet.PivotTables("PivotTable1").PivotFields("Quarter").PivotItems(QTD).ShowDetail = True
            End If
                On Error Resume Next
                Sheets(ActiveSheet.Index + 1).Activate
                If Err.Number <> 0 Then Sheets(1).Activate
        Next
End Sub