macro on pivot tables / pivot items

[markx]

Hi Guys,

Do you know how to print all the pivot items separately (instead of printing
the whole pivot table...)?
Intuitively I think about a macro that will show one pivot item after
another then print the page, but I'm failing to achieve this through VBA
coding, since already 3 days (and nights)... :-(

Thanks for any hints/help on this,
Regards,
Markx

 

[Bernie Deitrick]

Markx,

This will work for the row field "Name" in a pivottable named PivotTable1

Sub PrintPTMacro()
Dim i As Integer
Dim j As Integer

With ActiveSheet.PivotTables("PivotTable1").PivotFields("Name")
For i = 1 To .PivotItems.Count
.PivotItems(i).Visible = True
For j = 1 To .PivotItems.Count
If j <> i Then .PivotItems(j).Visible = False
Next j
ActiveSheet.PrintOut
MsgBox .PivotItems(i).Name & " is now printing"
Next i
End With
End Sub


HTH,
Bernie
MS Excel MVP

 

[markx]

Thank you Bernie, works perfectly!
I'll study your code like the Bible...

Regards,
Markx

 

[beancurdjelly2003]

Hi,

If I want to save as file instead of print out? How can I do it?

Thanks!

 

[Bernie Deitrick]

Try this one...

HTH,
Bernie
MS Excel MVP



Sub SavePTMacro()
Dim i As Integer
Dim j As Integer
Dim myB As Workbook

With ActiveSheet.PivotTables("PivotTable1").PivotFields("Name")
For i = 1 To .PivotItems.Count
.PivotItems(i).Visible = True
For j = 1 To .PivotItems.Count
If j <> i Then .PivotItems(j).Visible = False
Next j
ActiveSheet.Cells.Copy
Set myB = Workbooks.Add
myB.Sheets(1).Cells.PasteSpecial xlPasteValues
myB.SaveAs ThisWorkbook.Path & "\" & .PivotItems(i).Name & ".xls"
MsgBox .PivotItems(i).Name & " has been saved to a new file"
myB.Close
Next i
End With
End Sub

 

[beancurdjelly2003]

Try this one...

HTH,
Bernie
MS Excel MVP

Sub SavePTMacro()
Dim i As Integer
Dim j As Integer
Dim myB As Workbook

With ActiveSheet.PivotTables("PivotTable1").PivotFields("Name")
For i = 1 To .PivotItems.Count
.PivotItems(i).Visible = True
For j = 1 To .PivotItems.Count
If j <> i Then .PivotItems(j).Visible = False
Next j
ActiveSheet.Cells.Copy
Set myB = Workbooks.Add
myB.Sheets(1).Cells.PasteSpecial xlPasteValues
myB.SaveAs ThisWorkbook.Path & "\" & .PivotItems(i).Name & ".xls"
MsgBox .PivotItems(i).Name & " has been saved to a new file"
myB.Close
Next i
End With
End Sub








- $Bp}<(Ho0zMQJ8;z(B -

Thanks Bernie. It work, but only save one file then show run time
error 1004....

How can same format on Pivottable1 (color, font... ...) when split out
the pivot item?

 

[Bernie Deitrick]

Try this:

Sub PrintPTMacro()
Dim i As Integer
Dim j As Integer
Dim myB As Workbook

With ActiveSheet.PivotTables("PivotTable1").PivotFields("Name")
For i = 1 To .PivotItems.Count
.PivotItems(i).Visible = True
For j = 1 To .PivotItems.Count
If j <> i Then .PivotItems(j).Visible = False
Next j
ActiveSheet.Cells.Copy
Set myB = Workbooks.Add
myB.Sheets(1).Cells.PasteSpecial xlPasteValues
myB.Sheets(1).Cells.PasteSpecial xlPasteFormats
myB.SaveAs ThisWorkbook.Path & "\" & .PivotItems(i).Name & ".xls"
MsgBox .PivotItems(i).Name & " has been saved to a new file"
myB.Close False
Next i
End With
End Sub

 

[beancurdjelly2003]

Try this:

Sub PrintPTMacro()
Dim i As Integer
Dim j As Integer
Dim myB As Workbook

With ActiveSheet.PivotTables("PivotTable1").PivotFields("Name")
For i = 1 To .PivotItems.Count
.PivotItems(i).Visible = True
For j = 1 To .PivotItems.Count
If j <> i Then .PivotItems(j).Visible = False
Next j
ActiveSheet.Cells.Copy
Set myB = Workbooks.Add
myB.Sheets(1).Cells.PasteSpecial xlPasteValues
myB.Sheets(1).Cells.PasteSpecial xlPasteFormats
myB.SaveAs ThisWorkbook.Path & "\" & .PivotItems(i).Name & ".xls"
MsgBox .PivotItems(i).Name & " has been saved to a new file"
myB.Close False
Next i
End With
End Sub

--
HTH,
Bernie
MS Excel MVP







- $Bp}<(Ho0zMQJ8;z(B -

Hi,

Still show error message 1004 when success to split out on PivotField
name....
But the format are ok, if the split out file need the drill data how
can i do? Can I run the Pivot Table's name instead of PivotTable1?

 

[beancurdjelly2003]

Hi,

Still show error message 1004 when success to split out on the first of PivotField
name....(only success save 1 file)
But the format are ok, how the split out file need the drill data?
How can i do? Can I run the Pivot Table's name (Sheet name) instead of PivotTable1?

 

[beancurdjelly2003]

Still show error message 1004 when success to split out on the first
of PivotField
name....(only success save 1 file)
But the format are ok, how the split out file need the drill data?
How can i do? Can I run the Pivot Table's name (Sheet name) instead
of PivotTable1?

 

[beancurdjelly2003]

Still show error message 1004 when success to split out on the first
of PivotField
name....(only success save 1 file)
But the format are ok, how the split out file need the drill data?
How can i do? Can I run the Pivot Table's name (Sheet name) instead
of PivotTable1?

I know that why show error 1004, because the second pivotfield name is
no data, so the marco cannot save a file without the name...
Now can i do?

 

[beancurdjelly2003]

I know that why show error 1004, because the second pivotfield name is
no data, so the marco cannot save a file without the name...
Now can i do?

Hi Bernie,

How can get the drill data from split file of Pivot table, because
each person need the detail of records. Thanks!

 

[Bernie Deitrick]

You should consider using a macro to filter the database based on each
user's needs, then copying the visible cells to a new workbook and then
basing a new PT on that subset of data. That will give the functionality
that you require.

Is that something that sounds good? Otherwise, set the pivot table to where
you want it, then save the entire file with a new name, and send the file
(with all the data, and the pivot table) to the user.

Bernie