Create copies of current pivot table by flipping filters based on a list

[TheHack22]

Hi All,

Hope this is possible and someone would be able to help me with their expertise.

I have a current current VBA code, which I considered manual. See code below.
I have to create multiple pivot tables weekly. I do this by making multiple copies of the Pivot Master Sheet and just flip the filters ( to show the different regions PT).
So, I make a copy of the sheet (name "Pivot table") based on the region name in the filter I selected. So if I select "Western" in filters that's the name I give to the copied sheet.
I have create multiple subs below for each region name.

Objective: I would ideally like to run a single sub,
that looks at a list of regions (Screen Shot) I wanted,
change the filters to reflect each item at a time,
then make a copy of that new region filter applied,
Loop through the list the continue with the other regions

Can someone please help me here?

Sub Western()

'Clear row filter and select Southern

'Clear row Filter
ActiveSheet.PivotTables("PivotTable2").PivotFields( _
"[Look_Up_Data].[Region].[Region]").ClearAllFilters


'Select filter for Western
ActiveSheet.PivotTables("PivotTable2").PivotFields( _
"[Look_Up_Data].[Region].[Region]").VisibleItemsList = Array( _
"[Look_Up_Data].[Region].&[Western]")


'Clear Filters and select Southern
ActiveSheet.PivotTables("PivotTable3").PivotFields( _
"[Data_For_Reports].[REGION].[REGION]").VisibleItemsList = Array( _
"[Data_For_Reports].[REGION].&[Western]")

End Sub

Sub Western_Copyrenameworksheet2()

Dim ws As Worksheet
Set wh = Worksheets(ActiveSheet.Name)
ActiveSheet.Copy After:=Worksheets(Sheets.Count)
If wh.Range("A1").Value <> "" Then
ActiveSheet.Name = wh.Range("A1").Value
End If
wh.Activate

End Sub