All Pivot table include different pivot field to save as individualworkbook

[beancurdjelly2003]

I wrote a macro to split out the active pivot table to individual file
by different pivot field. I don't how can I change it to split out all
pivot table on active workbook, because in this workbook have 7 sheet,
each sheet have 1 pivot table. I need to save as individual file with
all pivot table by different pivot field. (e.g. All Sheet include Name
A to save as individual workbook), Who can help me?

Here is my existing code
Sub SavePTMacro()
Dim i As Integer
Dim j As Integer
Dim pt As PivotTable
Dim pf As PivotField
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).Paste
Set pt = myB.Sheets(1).PivotTables(1)
For Each pf In pt.PivotFields
pf.EnableItemSelection = False
Next pf
myB.SaveAs ThisWorkbook.Path & "\" & ActiveSheet.Name & "_"
& .PivotItems(i).Name & ".xls"
myB.Close False
Next i
End With
End Sub

 

[beancurdjelly2003]

I wrote a macro to split out the active pivot table to individual file
by different pivot field. I don't how can I change it to split out all
pivot table on active workbook, because in this workbook have 7 sheet,
each sheet have 1 pivot table. I need to save as individual file with
all pivot table by different pivot field. (e.g. All Sheet include Name
A to save as individual workbook), Who can help me?

Here is my existing code
Sub SavePTMacro()
Dim i As Integer
Dim j As Integer
Dim pt As PivotTable
Dim pf As PivotField
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).Paste
Set pt = myB.Sheets(1).PivotTables(1)
For Each pf In pt.PivotFields
pf.EnableItemSelection = False
Next pf
myB.SaveAs ThisWorkbook.Path & "\" & ActiveSheet.Name & "_"
& .PivotItems(i).Name & ".xls"
myB.Close False
Next i
End With
End Sub

Anyone have idea?

 

[beancurdjelly2003]

Anyone have idea?- $Bp,i6Ho0zMQJ8;z(B -

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

Please~~~Who can teach me~~~

 

[Debra Dalgleish]

It's not totally clear what you're trying to do, but if each pivot table
has a "Name" field, the following might get you started:

'==================================================
Sub SavePTMacro()
Dim i As Integer
Dim j As Integer
Dim pt As PivotTable
Dim myB As Workbook
Dim ws As Worksheet
Dim ptNew As PivotTable
Dim pfNew As PivotField

For Each ws In ThisWorkbook.Worksheets
For Each pt In ws.PivotTables
With pt.PivotFields("Name")
.AutoSort xlManual, .SourceName
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
ws.Cells.Copy
Set myB = Workbooks.Add
myB.Sheets(1).Paste
Set ptNew = myB.Sheets(1).PivotTables(1)
For Each pfNew In ptNew.PivotFields
pfNew.EnableItemSelection = False
Next pfNew
myB.SaveAs ThisWorkbook.Path & "\" _
& ws.Name & "_" & .PivotItems(i).Name & ".xls"
myB.Close False
Next i
End With
Next pt
Next ws


End Sub
'============================================

 

[beancurdjelly2003]

It's not totally clear what you're trying to do, but if each pivot table
has a "Name" field, the following might get you started:

'==================================================
Sub SavePTMacro()
Dim i As Integer
Dim j As Integer
Dim pt As PivotTable
Dim myB As Workbook
Dim ws As Worksheet
Dim ptNew As PivotTable
Dim pfNew As PivotField

For Each ws In ThisWorkbook.Worksheets
For Each pt In ws.PivotTables
With pt.PivotFields("Name")
.AutoSort xlManual, .SourceName
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
ws.Cells.Copy
Set myB = Workbooks.Add
myB.Sheets(1).Paste
Set ptNew = myB.Sheets(1).PivotTables(1)
For Each pfNew In ptNew.PivotFields
pfNew.EnableItemSelection = False
Next pfNew
myB.SaveAs ThisWorkbook.Path & "\" _
& ws.Name & "_" & .PivotItems(i).Name & ".xls"
myB.Close False
Next i
End With
Next pt
Next ws

End Sub
'============================================









--
Debra Dalgleish
Contextureshttp://www.contextures.com/tiptech.html- $Bp,i6Ho0zMQJ8;z(B -

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

Hi, When I copy your code in my macro, shown run time error 1004,
"Application-defined or object-defined error". How can I do?

Actually, I need to split out same Pivot Field "Name" in all Pivot
table in different Worksheet and save as the file. e.g. said Name A,
shown on active workbook in all pivot table, I need to save as other
workbook with name A and 7 sheet with 7 pivot table. But, I cannot do
it, just only can split out the active worksheet.

 

[beancurdjelly2003]

Hi, When I copy your code in my macro, shown run time error 1004,
"Application-defined or object-defined error". How can I do?

Actually, I need to split out same Pivot Field "Name" in all Pivot
table in different Worksheet and save as the file. e.g. said Name A,
shown on active workbook in all pivot table, I need to save as other
workbook with name A and 7 sheet with 7 pivot table. But, I cannot do
it, just only can split out the active worksheet.- $Bp,i6Ho0zMQJ8;z(B -

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

Please really want to your hand to get help. Thanks!