excelinterest
New member
- Joined
- Jan 6, 2016
- Messages
- 1
- Reaction score
- 0
- Points
- 0
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 (vb):
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. What is wrong in there and what needs to be changed?
Any help will be very useful... Thanks in advance
Code (vb):
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. What is wrong in there and what needs to be changed?
Any help will be very useful... Thanks in advance