• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copy filter data in another worksheet in form of PT

KiKi

Member
I have a raw data in "Data Entry" tab of a excel and i want to copy filtered data (Column 5: employee) to a new worksheet in the form of a Pivot table. I have written down the below code:
Code:
Dim srcsht As Worksheet, dstsht As Worksheet
Dim srcrng As Range

Set srcsht = Sheets("Data Entry")
Set srcrng = srcsht.Range("A:M")

With srcsht
    'Create unique list of names from column E into Column Q
    .Range("E:E").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("E:E"), CopyToRange:=.Range("Q1"), Unique:=True
    lr = .Cells(Rows.Count, "Q").End(xlUp).Row

For Each c In .Range("Q2:Q" & lr)
Sheets.Add After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        On Error Resume Next
        ActiveSheet.Name = c.Value
Set dstsht = Sheets(c.Value)
srcrng.AutoFilter Field:=5, Criteria1:=c.Value
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=srcrng.SpecialCells(xlCellTypeVisible).Copy, Version:=xlPivotTableVersion14).CreatePivotTable _
            TableDestination:=dstsht.Range("A1"), TableName:=c.Value, DefaultVersion _
            :=xlPivotTableVersion14

This code is creating a new sheet with name of a filter but not creating pivot table. Any help will be very useful... Thanks in advance

Mod Edit: Code tags added
 
Last edited by a moderator:
I have a raw data in "Data Entry" tab of a excel and i want to copy filtered data (Column 5: employee) to a new worksheet in the form of a Pivot table. I have written down the below code:
Code:
Dim srcsht As Worksheet, dstsht As Worksheet
Dim srcrng As Range

Set srcsht = Sheets("Data Entry")
Set srcrng = srcsht.Range("A:M")

With srcsht
    'Create unique list of names from column E into Column Q
    .Range("E:E").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("E:E"), CopyToRange:=.Range("Q1"), Unique:=True
    lr = .Cells(Rows.Count, "Q").End(xlUp).Row

For Each c In .Range("Q2:Q" & lr)
Sheets.Add After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        On Error Resume Next
        ActiveSheet.Name = c.Value
Set dstsht = Sheets(c.Value)
srcrng.AutoFilter Field:=5, Criteria1:=c.Value
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=srcrng.SpecialCells(xlCellTypeVisible).Copy, Version:=xlPivotTableVersion14).CreatePivotTable _
            TableDestination:=dstsht.Range("A1"), TableName:=c.Value, DefaultVersion _
            :=xlPivotTableVersion14

This code is creating a new sheet with name of a filter but not creating pivot table. Any help will be very useful... Thanks in advance

Mod Edit: Code tags added
Any help?
 
Back
Top