Copy pivot data in every sheets and save as to a new file
Hi there
Please help me, I want to split all the data based on column criteria, and create a pivot table for all sheets. Afterwards, all sheets that containing pivot table will copy into sheet template.
When the pivot is copied, macro will save sheet template to a new file. (like incremental save as to new file)
here is what i've done so far
[VBA]Option Explicit
Sub SplitData()
Dim wbNew As Workbook
Dim wsData As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim rngCrit As Range
Dim LastRow As Long
Dim FPath As String
FPath = ActiveSheet.Parent.Path & "\"
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set wsData = Worksheets("Data Sample")
With ActiveSheet.PivotTables("PivotTable1").PivotFields("cust")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("sEQ")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Name")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Header17")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Header12")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Header13")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Header14")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Header15")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Header10")
.Orientation = xlPageField
.Position = 1
End With
Columns("AC:AH").Select
Selection.EntireColumn.Hidden = True
.Cells(.Rows.Count, "AA").End(xlUp).Offset(0, 0).Select
Selection.Delete
End With
ThisWorkbook.ShowPivotTableFieldList = False
Application.CommandBars("PivotTable").Visible = False
End With
'Range("Z:AI").Select
End Sub[/VBA]