Adding a pivot table to a new sheet with data on the same sheet

Question

My code creates a new sheet as per below code which is ws2 where I have a table extracted from ws1. I want to place a pivot table on the same sheet ws2 in cell "L4" as per bottom part of the code, but it would not work.

Sub ClickThisMacro() Dim i As Long Dim y As Long Dim n As Long Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Report") Dim ws2 As Worksheet: Set ws2 = Sheets.Add Set rng1 = ws1.Range("A:A").Find("Name") fr = rng1.Row lr = ws1.Range("B" & Rows.Count).End(xlUp).Row y = 2 For i = fr + 1 To lr ws2.Cells(y, 1) = ws1.Cells(i, 1) ws2.Cells(y, 2) = ws1.Cells(i, 2) ws2.Cells(y, 3) = ws1.Cells(i, 3) ws2.Cells(y, 4) = ws1.Cells(i, 4) ws2.Cells(y, 5) = ws1.Cells(i, 18) y = y + 1 Next i ws2.Cells(1, 1) = "Cost centre name" ws2.Cells(1, 2) = "Cost centre code" ws2.Cells(1, 3) = "Phone number" ws2.Cells(1, 4) = "User name" ws2.Cells(1, 5) = "Amount" LastRow = ws2.Range("A1").End(xlDown).Row ' making columns C and F numbers ws2.Range("C2:C" & LastRow).Select For Each xCell In Selection xCell.Value = xCell.Value Next xCell With ws2.UsedRange.Columns(5) .Replace "£", "", xlPart .NumberFormat = "#,##0.00" .Formula = .Value End With With ws2.UsedRange.Columns(8) .Replace "£", "", xlPart .NumberFormat = "#,##0.00" .Formula = .Value End With 'Pivot table Dim mypivot As PivotTable Dim mycache As PivotCache Set mycache = ws2.PivotCaches.Create(xlDatabase, Range("a1").CurrentRegion) Set mypivot = ws2.PivotTables.Add(mycache.Range("l4"), "Mypivot1") mypivot.PivotFields("Cost centre name").Orientation = xlRowField mypivot.PivotFields("Cost centre code").Orientation = xlColumnField mypivot.PivotFields("Amount").Orientation = xlDataField End Sub

Shai Rado · Accepted Answer · 2018-03-25 06:04:33Z

You have a few syntax errors in your code at the section where you set your PivotCache and PivotTable objects.

Modified code (Pivot-Table section)

' set the Pivot-Cache Set mycache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=ws2.Range("A1").CurrentRegion.Address(False, False, xlA1, xlExternal)) ' set the Pivot-Table object Set mypivot = ws2.PivotTables.Add(PivotCache:=mycache, TableDestination:=ws2.Range("L4"), TableName:="Mypivot1") With mypivot .PivotFields("Cost centre name").Orientation = xlRowField .PivotFields("Cost centre code").Orientation = xlColumnField .PivotFields("Amount").Orientation = xlDataField End With

Some Other modifications/suggestions you should add to your code:

Using Find you should handle a scenario (even though unlikely) that you won't find the term you are looking for, in that case if Rng1 = Nothing then fr = Rng1.Row will result with a run-time error.

Dealing with Find code:

Set Rng1 = ws1.Range("A:A").Find("Name") If Not Rng1 Is Nothing Then ' confirm Find was successfull fr = Rng1.Row Else ' if Find fails MsgBox "Critical Error, couldn't find 'Name' in column A", vbCritical Exit Sub End If

You should avoid using Select and Selection, you can use fully qualified Range object instead:

Looping through a Range:

For Each xCell In ws2.Range("C2:C" & lr) xCell.Value = xCell.Value Next xCell

Collectives™ on Stack Overflow

Adding a pivot table to a new sheet with data on the same sheet

1 Answer 1

1 Comment

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Related