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

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" wrote in message
...
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

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

Regards,
Markx

"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
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" wrote in message
...
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

Hi,

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

Thanks!

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

wrote in message
...
Hi,

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

Thanks!

On 5$B7n(B5$BF|(B, $B2<8a(B10$B;~(B37$BJ,(B, "Bernie Deitrick" <deitbe @ consumer dot org
wrote:
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

wrote in message

...



Hi,

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

Thanks!- $Bp,i6Ho0zMQJ8;z(B -

- $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?

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


wrote in message
...
On 5$B7n(B5$BF|(B, $B2<8a(B10$B;~(B37$BJ,(B, "Bernie Deitrick" <deitbe @ consumer dot org
wrote:
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

wrote in message

...



Hi,

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

Thanks!- $Bp,i6Ho0zMQJ8;z(B -

- $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?

On 5$B7n(B8$BF|(B, $Be8a(B2$B;~(B18$BJ,(B, "Bernie Deitrick" <deitbe @ consumer dot org wrote:
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

wrote in message

...



On 5$B7n(B5$BF|(B, $B2<8a(B10$B;~(B37$BJ,(B, "Bernie Deitrick" <deitbe @ consumer dot org
wrote:
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

wrote in message

...

Hi,

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

Thanks!- $Bp,i6Ho0zMQJ8;z(B -

- $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?- $Bp,i6Ho0zMQJ8;z(B -

- $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?

On 5$B7n(B8$BF|(B, $Be8a(B2$B;~(B49$BJ,(B, wrote:
On 5$B7n(B8$BF|(B, $Be8a(B2$B;~(B18$BJ,(B, "Bernie Deitrick" <deitbe @ consumer dot org wrote:





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

wrote in message

...

On 5$B7n(B5$BF|(B, $B2<8a(B10$B;~(B37$BJ,(B, "Bernie Deitrick" <deitbe @ consumer dot org
wrote:
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

wrote in message

...

Hi,

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

Thanks!- $Bp,i6Ho0zMQJ8;z(B -

- $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?- $Bp,i6Ho0zMQJ8;z(B -

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

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?

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?

On 5$B7n(B8$BF|(B, $Be8a(B2$B;~(B54$BJ,(B, wrote:
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?

On 5$B7n(B8$BF|(B, $Be8a(B3$B;~(B13$BJ,(B, wrote:
On 5$B7n(B8$BF|(B, $Be8a(B2$B;~(B54$BJ,(B, wrote:

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?

Hi Bernie,

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

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


wrote in message
...
On 5$B7n(B8$BF|(B, $Be8a(B3$B;~(B13$BJ,(B, wrote:
On 5$B7n(B8$BF|(B, $Be8a(B2$B;~(B54$BJ,(B, wrote:

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?

Hi Bernie,

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