Need help to correct code

[Spooky7]

Hi part of my code is not working and need your assistance. I am getting an error message on PI.Visible = True.

Sub CopyPivData()
Dim PT As PivotTable
Dim PI As PivotItem
Dim PI2 As PivotItem

MyWs = "Summary PIVOT"
MyPIV = "PivotTable1"
MyField = "Process Owner"
Set PT = Worksheets(MyWs).PivotTables(MyPIV)
With PT
For Each PI In Worksheets(MyWs).PivotTables(MyPIV).PivotFields(MyField).PivotItems
PI.Visible = True
For Each PI2 In Worksheets(MyWs).PivotTables(MyPIV).PivotFields(MyField).PivotItems
If Not PI2.Name = PI.Name Then PI2.Visible = False
Next PI2
Set NewWs = Worksheets.Add
NewWs.Name = PI

Worksheets(MyWs).Range("A3:O724").Copy
NewWs.Range("A1").Select
ActiveSheet.Paste
Next PI
End With
End Sub

[p45cal]

This is a guess. A file from you would be useful. Saves us guessing wrong.

Sub CopyPivData()
Dim PT As PivotTable
Dim PI As PivotItem
Dim PI2 As PivotItem

MyWs = "Summary PIVOT"
MyPIV = "PivotTable1"
MyField = "Process Owner"
Set PT = Worksheets(MyWs).PivotTables(MyPIV)
With PT
  .PivotCache.MissingItemsLimit = xlMissingItemsNone
  .PivotCache.Refresh
  For Each PI In .PivotFields(MyField).PivotItems
    PI.Visible = True
    For Each PI2 In .PivotFields(MyField).PivotItems
      If Not PI2.Name = PI.Name Then PI2.Visible = False
    Next PI2
    Set NewWs = Worksheets.Add
    NewWs.Name = PI
    Worksheets(MyWs).Range("A3:O724").Copy
    NewWs.Range("A1").Select
    ActiveSheet.Paste
  Next PI
End With
End Sub

There are 2 things I've done here:
1. You have Set PT = Worksheets(MyWs).PivotTables(MyPIV) but you never use it, now it's used.
2. Added 2 lines: to remove old items and to refresh the table.
You might be lucky and it'll work, otherwise it could be more complex (have you other filters on other fields which could be interfering?) and we'd need a file.

[Spooky7]

Thank you so much. Appreciate your help and prompt response How do I make a donation to you?

I also want to add on an extra code to copy and paste the worksheets as a Table so its neat and tidy but getting an error when I add the below code. Can you please advise.

Sub Test()
    Dim Sh As Worksheet
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Visible = True Then
            Sh.Activate
            Sh.Cells.Copy
            Sh.Range("A1").PasteSpecial Paste:=xlValues
            Sh.Range("A1").Select
        End If
    Next Sh
    Application.CutCopyMode = False
End Sub

[SamT]

P45Cal,
I'm confused.

For Each PI In .PivotFields(MyField).PivotItems 
                PI.Visible = True 
    For Each PI2 In .PivotFields(MyField).PivotItems 
                      If Not PI2.Name = PI.Name Then PI2.Visible = False 
   Next PI2 
            Next PI

Doesn't that set every PI2, other than the current PI, to visible = False, leaving only the last PI visible?

Please note, here is everything I know about Pivot Tables: "."

[SamT]

Spooky,

Sub Test() 
    Dim Sh As Worksheet 

    Application.ScreenUpdating = False
On Error GoTo GracefulExit

    For Each Sh In ThisWorkbook.Worksheets 
        If Sh.Visible = xlSheetVisible Then 
            With Sh
            .Cells.Copy 
            .Range("A1").PasteSpecial Paste:=xlPasteValues 
            End With
End If 
    Application.CutCopyMode = False 
Next Sh 

GracefulExit:
    Application.ScreenUpdating =True
    End Sub

[Spooky7]

Thank you! When I add your code to my existing code I get a Compile error: For control variable already in use? Please let me know what is wrong? Thanks for your help!

Sub CopyPivData() 
    Dim PT As PivotTable 
    Dim PI As PivotItem 
    Dim PI2 As PivotItem 
     
    MyWs = "Summary PIVOT" 
    MyPIV = "PivotTable1" 
    MyField = "Process Owner" 
    Set PT = Worksheets(MyWs).PivotTables(MyPIV) 
    With PT 
        .PivotCache.MissingItemsLimit = xlMissingItemsNone 
        .PivotCache.Refresh 
        For Each PI In .PivotFields(MyField).PivotItems 
            PI.Visible = True 
            For Each PI2 In .PivotFields(MyField).PivotItems 
                If Not PI2.Name = PI.Name Then PI2.Visible = False 
            Next PI2 
            Set NewWs = Worksheets.Add 
            NewWs.Name = PI 
            Worksheets(MyWs).Range("A3:O724").Copy 
            NewWs.Range("A1").Select 
            ActiveSheet.Paste

Sub Test() 
    Dim Sh As Worksheet 
     
    Application.ScreenUpdating = False 
    On Error GoTo GracefulExit 
     
    For Each Sh In ThisWorkbook.Worksheets 
        If Sh.Visible = xlSheetVisible Then 
            With Sh 
                .Cells.Copy 
                .Range("A1").PasteSpecial Paste:=xlPasteValues 
            End With 
        End If 
        Application.CutCopyMode = False 
    Next Sh 
     
GracefulExit: 
    Application.ScreenUpdating =True  

Next PI 
    End With 
End Sub

[SamT]

This is the last time I will format the code in your posts.
You can select the code, then click the # icon on the Editor menu, or
You can click the icon, then paste the code bwteen the [ Code} and {/ Code] tags, or
You can manually type the code tags before and after your code.

Note. don't leave any spaces in the code tags. I had to above so they would not be actually seen as tags.

[Spooky7]

Thank you very much for your help.

[SamT]

Now that I have formatted your code, take a look at your last post and see if you can tell what's wrong.

Before I offer any more code, I have a question. Do you only want the new Worksheets (Named for the PivotItem) to be formatted as tables per your post # 3?

[Spooky7]

Yes only the new worksheets to be formatted as Tables.

[SamT]

Option Explicit

Sub CopyPivData()
'Copies the data Values for each PivotItem to a new Sheet Named per the PI Name
'For help go to "http://www.vbaexpress.com/forum/showthread.php?53467-Need-help-to-correct-code#post329495"
    
    Dim PT As PivotTable
    Dim PI As PivotItem
     
    MyWs = "Summary PIVOT"
    MyPIV = "PivotTable1"
    MyField = "Process Owner"
    Set PT = Worksheets(MyWs).PivotTables(MyPIV)
    
    Application.ScreenUpdating = False
    On Error GoTo GracefulExit 'Prevents exiting while ScreenUpdating is False
     
    With PT
        .PivotCache.MissingItemsLimit = xlMissingItemsNone
        .PivotCache.Refresh
        
        'Hide all Items
        For Each PI In .PivotFields(MyField).PivotItems
            PI.Visible = False
        Next PI
            
        For Each PI In .PivotFields(MyField).PivotItems
            PI.Visible = True
            Set NewWs = Worksheets.Add
            NewWs.Name = PI.Name '<<<<<<<< added PI Name Property
            Worksheets(MyWs).Range("A3:O724").Copy
            NewWs.Range("A1").PasteSpecial xlPasteValues 'Eliminate Sub "Test"
            PI.Visible = False
        Next PI
        
         'Show all Items
         For Each PI In .PivotFields(MyField).PivotItems
            PI.Visible = True
         Next PI
    End With
    
GracefulExit:
    Application.ScreenUpdating = True
End Sub

[p45cal]

P45Cal,
I'm confused.

For Each PI In .PivotFields(MyField).PivotItems 
                PI.Visible = True 
    For Each PI2 In .PivotFields(MyField).PivotItems 
                      If Not PI2.Name = PI.Name Then PI2.Visible = False 
   Next PI2 
            Next PI

Doesn't that set every PI2, other than the current PI, to visible = False, leaving only the last PI visible?

Please note, here is everything I know about Pivot Tables: "."

Yes, I think so, ultimately. But other things are happening inside the outer loop that I think the op wanted.

[p45cal]

Thank you so much. Appreciate your help and prompt response How do I make a donation to you?

You could do it via a paypal email address (Private Message me here for it), but it really isn't necessary; the only acknowledgement I'm looking for is what you've already done, that is, replied. Even a Marked as Solved would have done.
What I despise, and it's happening more, is that someone gets help here and there's no evidence that they've even read the response, let alone used it. When it's evident that considerable effort has been made to give that person (free) help [I believe] it is absolutely incumbent on them to acknowledge it. Perhaps beause the help here is free, some people value it at zero.

[Spooky7]

Thank you SamT and P45cal your help is greatly appreciated.

[Spooky7]

I sent a private message.

[p45cal]

Yes only the new worksheets to be formatted as Tables.

Do I take it that your copy range (A3:O724) in msg#1 includes the entirety of the pivot table and you're ending up with a pivot table on each new sheet, which you don't really want?

[SamT]

I got to thinking that you might have a lot of PivotItems and the loop might take some time. I added a note to the Excel StatusBar . I also corrected a couple of small errors in the code above. This code will Compile, but it is not otherwise tested.

Option Explicit

Sub CopyPivData()
'Copies the data Values for each PivotItem to a new Sheet Named per the PI Name
'For help go to "http://www.vbaexpress.com/forum/showthread.php?53467-Need-help-to-correct-code#post329495"
    
    Dim PT As PivotTable
    Dim PI As PivotItem
    Dim NewWs As Worksheet
    Dim StatusBarVisiblity  As Boolean
    Dim PICount As Long 'Used in Staus Bar Updating
    Dim PINum As Long   'Used in Staus Bar Updating
    Dim StatusBarUpdateFrequency As Long
    
    Const MyWs = "Summary PIVOT"
    Const MyPIV = "PivotTable1"
    Const MyField = "Process Owner"
    
    Set PT = Worksheets(MyWs).PivotTables(MyPIV)
    
    
    With Application
      .ScreenUpdating = False
       StatusBarVisiblity = .DisplayStatusBar
      .StatusBar = "Please be patient... Just starting to work"
    End With

    On Error GoTo GracefulExit 'Prevents exiting while ScreenUpdating is False
     
    With PT
        .PivotCache.MissingItemsLimit = xlMissingItemsNone
        .PivotCache.Refresh
        PICount = .PivotFields(MyField).PivotItems.Count
        StatusBarUpdateFrequency = PICount \ 10 'Updates @ 10% increments
        
        'Hide all Items
        For Each PI In .PivotFields(MyField).PivotItems
            PI.Visible = False
        Next PI
            
        For Each PI In .PivotFields(MyField).PivotItems
            PINum = PINum + 1
            PI.Visible = True
            Set NewWs = Worksheets.Add
            NewWs.Name = PI.Name '<<<<<<<< added PI Name Property
            Worksheets(MyWs).Range("A3:O724").Copy
            NewWs.Range("A1").PasteSpecial xlPasteValues 'Eliminate Sub "Test"
            PI.Visible = False
            If PINum Mod StatusBarUpdateFrequency < 1 Then _
              Application.StatusBar = "Please be patient... " & _
              Format((PINum / PICount) * 100, "00") & "% complete"
        Next PI
        
         'Show all Items
         For Each PI In .PivotFields(MyField).PivotItems
            PI.Visible = True
         Next PI
    End With
    
GracefulExit:
    With Application
      .ScreenUpdating = True
      .StatusBar = False
      .DisplayStatusBar = StatusBarVisiblity
    End With
End Sub

[Spooky7]

yes the copy range is A3 to O724 I just sent you a shorter version of the table.

[SamT]

Thank you SamT and P45cal your help is greatly appreciated.

Thank you.
Does the code do what you want?

ps: I'm off to do some chores. I'll check back later.

[Spooky7]

I will try the new version and see if it works the previous one didn't.