• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA code to loop through pivot table

Hello Team.

Please find below screenshot as i am unable to send a file.

Code should loop through each names and should click on the amount which shows data in separate sheet.

like Selection.ShowDetail = True

and should open corresponding name workbooks like "A","B" and so on and paste in the existing sheet as those workbook contains some other sheets of workings.

Hope am not confusing.


upload_2017-2-19_1-34-23.png
 
Hello Arpana.

I think you are looking for not looping through pivot table but pivot items..and wanted it to create sheets as the row labels.

Let me know!
 
Thanks Monty:)

Yes i was thinking it was pivot table may be pivot items.
But need to ensure loop through and click by code itself and create it detailed data and paste in corresponding workbook.

Iam not sure if this can be possible?:(
 
I can only give you broad-brush advice since you've only supplied a picture, so something of this ilk:
Code:
Sub blah()
Set pt = ActiveSheet.PivotTables(1)
Set pits = pt.PivotFields("????").PivotItems
For Each pit In pits
  If pit.Visible Then 'only acts on visible items
  pit.DataRange.ShowDetail = True
  'pit.name 'contains pivot item name that you could use to refer to a workbook to copy the data on the active sheet to, eg.;
  'ActiveSheet.ListObjects(1).DataBodyRange.Copy Workbooks(pit.Name).Sheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1)
  End If
Next pit
End Sub
 
Last edited:
Arpana.

Edited P45cal code.

When it creates data in a new sheet it will name it.

As per your question going into a folder and opening corresponding file and paste this data in that workbook will be easy.

Code:
Sub Test()
Dim pt As PivotTable
Dim sht As Worksheet
Set pt = ActiveSheet.PivotTables(1)
Set pits = pt.PivotFields("Name").PivotItems
For Each pit In pits
  If pit.Visible Then pit.DataRange.ShowDetail = True 'only acts on visible items
  ActiveSheet.Name = pit  'Added new line
Next pit
End Sub
 
p45cal

But it works for me, i have check the movement it creates a sheet it is naming it..Can please make me understand how this Activesheet.name=pit.
If the pivotitem isn't visible, the active sheet will still be renamed to the pivot item's name.
If the first item isn't visible, the sheet with the pivot table on will be renamed.
 
Arpanakumar,
Code:
Set pt = ActiveSheet.PivotTables(1)
Set pits = pt.PivotFields("hdr1").PivotItems
For Each pit In pits
  If pit.Visible Then  'only acts on visible items
    pit.DataRange.ShowDetail = True
    Set myData = ActiveSheet.ListObjects(1).DataBodyRange
        Set DestnWb = Workbooks(pit.Name).Open
    myData.Copy DestnWb.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1)
  End If
Next pit
 
Thank you P45cal for sharing your inputs.

I tried and edited this way..Please let me know to learn more.

Code:
Sub Test()
pt = ActiveSheet.PivotTables(1)
Set pits = pt.PivotFields("Name").PivotItems
path = "C:\Users\MONTY\Desktop\Test"
For Each pit In pits
  If pit.Visible Then  'only acts on visible items
  pit.DataRange.ShowDetail = True
    Set myData = ActiveSheet.ListObjects(1).DataBodyRange
        Set DestnWb = Workbooks.Open(path & "\" & pit.Name) 'Edited here
    myData.Copy DestnWb.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1)
  End If
Next pit
End Sub
 
Monty, that's fine.
Arpanakumar, on re-reading msg#1 I think you want to copy the sheet to the workbook. Use Monty's path too, to specify the location of the file.
Again, broad brush:
Code:
Set pt = ActiveSheet.PivotTables(1)
Set pits = pt.PivotFields("????").PivotItems
For Each pit In pits
  If pit.Visible Then
  pit.DataRange.ShowDetail = True  'only acts on visible items
  Set mySht = ActiveSheet
  mySht.Name = pit.Name
  mySht.ListObjects(1).Unlist 'converts table to normal range.
  Set DestnWb = Workbooks(pit.Name).Open
  mySht.Move After:=DestnWb.Sheets(DestnWb.Sheets.Count)
  End If
Next pit
 
Arpana.

Here is the complete code.

What macro does

1) IT loops through pivot table in pivot items called "Name" and clicks to show details in a separate sheet within the workbook.

2) Opens corresponding workbook and paste data and converts to range from table format.


3) And also additionally will delete the additional sheets in the master book as it is not required any more...just thought of it.

Code:
Sub Test1()
'Declaring variables

Dim pt As PivotTable
Dim pits As PivotItems
Dim Mainsht As Worksheet
Dim Mysht As Worksheet

Set Mainsht = ThisWorkbook.Worksheets("Pivot Sheet")
Mainsht.Activate
''Sheet where your actual pivot exists

'Set pivot table
Set pt = ActiveSheet.PivotTables(1)
'Set pivot Item which need to loop through
Set pits = pt.PivotFields("Name").PivotItems

'Path change as per your requirment
Path = "C:\Users\MONTY\Desktop\Test"


'Loop through pivot items
For Each pit In pits
    If pit.Visible Then  'only acts on visible items
    'Show data in a sheet
      pit.DataRange.ShowDetail = True
      Set Mysht = ActiveSheet
      Set myData = ActiveSheet.ListObjects(1).DataBodyRange
      'Remove Table format
          Mysht.ListObjects(1).Unlist
          'Open the corresponding workbook
          Set DestnWB = Workbooks.Open(Path & "\" & pit.Name) 'Edited here
          'Open the corresponding worbook and paste
          myData.Copy DestnWB.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1)
          Application.DisplayAlerts = False
          'Save and close source book
          DestnWB.Save
          DestnWB.Close
          Application.DisplayAlerts = True
    End If
    Mainsht.Activate
Next pit

'Delete the sheets which are not required in master file.

For Each Sht In ActiveWorkbook.Sheets
    If Sht.Name <> "Pivot Sheet" And Sht.Name <> "Pivot Data" Then
        Application.DisplayAlerts = False
        Sht.Select
        Sht.Delete
        Application.DisplayAlerts = True
    End If
   
Next Sht
MsgBox "Data copied from pivot", vbInformation, "Arpana"
End Sub
 
Back
Top