Cutting Down Repetitive code to Avoid "Procedure Too Large" error - excel

Question

I currently have some VBA code that essentially replaces a Filter Field in a PivotTable, but because the current excel spreadsheet has hundreds of PivotTables, I'm reaching to a point where the VBA doesn't work with Procedure too large.
Problem is I don't know how to decrease the repetition - any assistance would be certainly appreciated.
Code below:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("P6:P7")) Is Nothing Then Exit Sub
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String
Set pt = Worksheets("Pivot Booking").PivotTables("PivotTable8")
Set Field = pt.PivotFields("Company Code")
NewCat = Worksheets("Trending&Benchmarking").Range("P6").Value
With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
End With
Set pt = Worksheets("Pivot Booking").PivotTables("PivotTable6")
Set Field = pt.PivotFields("Company Code")
NewCat = Worksheets("Trending&Benchmarking").Range("P6").Value
With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
End With
Set pt = Worksheets("Pivot Booking").PivotTables("PivotTable20")
Set Field = pt.PivotFields("Company Code")
NewCat = Worksheets("Trending&Benchmarking").Range("P6").Value
With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
End With
Set pt = Worksheets("Pivot Booking").PivotTables("PivotTable7")
Set Field = pt.PivotFields("Company Code")
NewCat = Worksheets("Trending&Benchmarking").Range("P6").Value
With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
'Keeps on repeating for about 200 more PivotTables in Various Sheets
End With
End Sub

Answer 1

If you want to change all the pivot tables on that sheet:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("P6:P7")) Is Nothing Then Exit Sub
Dim pt As PivotTable, NewCat As String, s
NewCat = Worksheets("Trending&Benchmarking").Range("P6").Value
For Each s In Array("Pivot Booking", "Pivot Transaction", _
"Pivot Level Segment")
For Each pt In Worksheets(s).PivotTables
With pt.PivotFields("Company Code")
.ClearAllFilters
.CurrentPage = NewCat
End With
Next pt
Next s
End Sub

Answer 2

Thank you all - the complete code that has worked is as per below:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("P6:P7")) Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error GoTo ErrorHandler
Dim pt As PivotTable, NewCat As String, s
NewCat = Worksheets("Trending&Benchmarking").Range("P6").Value
For Each s In Array("Pivot Booking", "Pivot Transaction", "Pivot Level Segment", "Pivot YoY TransactionGraph")
For Each pt In Worksheets(s).PivotTables
With pt.PivotFields("Company Code")
.ClearAllFilters
.CurrentPage = NewCat
End With
Next pt
Next s
ErrorHandler:
Debug.Print Err.Number & vbNewLine & Err.Description
Resume ErrorExit
ErrorExit:
Application.EnableEvents = True
Exit Sub
End Sub