Thread
:
All Pivot table include different pivot field to save as individualworkbook
View Single Post
#
4
Posted to microsoft.public.excel.programming
Debra Dalgleish
external usenet poster
Posts: 2,979
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
Reply With Quote
Debra Dalgleish
View Public Profile
Find all posts by Debra Dalgleish