View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Debra Dalgleish Debra Dalgleish is offline
external usenet poster
 
Posts: 2,979
Default All Pivot table include different pivot field to save as individualworkbook

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
'============================================

wrote:
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



--
Debra Dalgleish
Contextures
http://www.contextures.com/tiptech.html