Loop through a pivot table filter and copy the sheet

[onche414]

Hello,

I have a pivot table in a worksheet and I would like to create a VBA code that will go select each value in the filter "ID", then copy the sheet and rename it with the value in the ID cell:

So for example, it will select store a, copy the sheet and rename it "store a", then select the second value which is store b, copy the sheet and rename it store b etc

Thank you !

 

[onche414]

I came up with this code but I am getting an error at the line "set source". Run time error '1004'

Sub DupliSheets()
Dim datarange As Range, source As Range, c As Range, sh2 As Worksheet

Set datarange = Worksheets("New Template").Range("B1")
Set sh2 = Sheets("New Template")
Set source = Evaluate(datarange.Validation.Formula1)

For Each c In source
    datarange.Value = c.Value
    sh2.Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = c.Value
    
Next
End Sub

Can anyone help please ?

 

[Domenic]

Try the following...

Sub DupliSheets()

    Dim wb As Workbook
    Dim sht As Worksheet
    Dim rng As Range
    Dim pt As PivotTable
    Dim pi As PivotItem
    
    Set wb = ThisWorkbook
    
    Set sht = wb.Worksheets("New Template")
    
    Set rng = sht.Range("B1")
    
    Set pt = sht.PivotTables("PivotTable1") 'change the name accordingly
    
    With pt
        .ClearAllFilters
        For Each pi In .PivotFields("ID").PivotItems
            rng.Value = pi.Value
            sht.Copy after:=wb.Sheets(wb.Sheets.Count)
            ActiveSheet.Name = pi.Value
        Next pi
        .ClearAllFilters
    End With
    
End Sub

Hope this helps!

 

[onche414]

Try the following...

Sub DupliSheets()

    Dim wb As Workbook
    Dim sht As Worksheet
    Dim rng As Range
    Dim pt As PivotTable
    Dim pi As PivotItem
   
    Set wb = ThisWorkbook
   
    Set sht = wb.Worksheets("New Template")
   
    Set rng = sht.Range("B1")
   
    Set pt = sht.PivotTables("PivotTable1") 'change the name accordingly
   
    With pt
        .ClearAllFilters
        For Each pi In .PivotFields("ID").PivotItems
            rng.Value = pi.Value
            sht.Copy after:=wb.Sheets(wb.Sheets.Count)
            ActiveSheet.Name = pi.Value
        Next pi
        .ClearAllFilters
    End With
   
End Sub

Hope this helps!

Worked perfectly, thanks !

 

[Domenic]

You're very welcome, cheers!