Consulting

Results 1 to 1 of 1

Thread: Copy pivot data in every sheets and save as to a new file

  1. #1
    VBAX Tutor
    Joined
    Sep 2007
    Posts
    265
    Location

    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")

    LastRow = wsData.Range("A" & Rows.Count).End(xlUp).Row

    Set wsCrit = Sheets("Setting")
    wsCrit.Visible = xlSheetVisible

    wsData.Range("D1" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True

    Set rngCrit = wsCrit.Range("A2")
    While rngCrit.Value <> ""
    Set wsNew = Worksheets.Add

    wsData.Range("A1:U" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCrit.Offset(-1).Resize(2), CopyToRange:=wsNew.Range("A1"), Unique:=True

    If wbNew Is Nothing Then
    wsNew.Copy
    Set wbNew = ActiveWorkbook
    wbNew.Worksheets(wbNew.Worksheets.Count).Name = rngCrit
    makepivot
    Else
    wsNew.Copy after:=wbNew.Worksheets(wbNew.Worksheets.Count)
    wbNew.Worksheets(wbNew.Worksheets.Count).Name = rngCrit
    makepivot

    End If

    Application.DisplayAlerts = False
    wsNew.Delete
    rngCrit.EntireRow.Delete
    Set rngCrit = wsCrit.Range("A2")
    Wend

    Dim sh As Worksheet, end_row As Long, source As Range

    end_row = ActiveSheet.Range("AA" & Rows.Count).End(xlUp).Row
    With ActiveWorkbook

    End With
    wsCrit.Visible = xlSheetVeryHidden


    With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    End With

    Application.DisplayAlerts = True

    End Sub

    Sub makepivot()

    With ActiveSheet
    lstrw_sh1 = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    Set Rng = ActiveSheet.Range("A1" & ":" & "U" & lstrw_sh1)
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=Rng) _
    .CreatePivotTable TableDestination:=ActiveSheet.Range("AA13"), _
    TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion10

    ThisWorkbook.ShowPivotTableFieldList = True


    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

    With ActiveSheet
    .PivotTables("PivotTable1").PivotFields("Name").Subtotals = _
    Array(False, False, False, False, False, False, False, False, False, False, False, False)

    .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]

    Appreciate your help.
    Harto
    Attached Files Attached Files

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •