Add pivot table to a worksheet name

VbaHell

Well-known Member
Joined
Jan 30, 2011
Messages
1,220
Hello all

This code creates a pivot table and work well but instead on adding to a new worksheet how can I change it to always populate a worksheet called £Test" please

Sub CreatePivot()
Application.DisplayAlerts = False
Dim objTable As PivotTable, objField As PivotField

ActiveWorkbook.Sheets("OSDD").Select
Range("A1").Select

Set objTable = Sheets("OSDD").PivotTableWizard

Set objField = objTable.PivotFields("Station")
objField.Orientation = xlRowField
Set objField = objTable.PivotFields("Month")
objField.Orientation = xlColumnField

Set objField = objTable.PivotFields("OSDD No")
objField.Orientation = xlDataField
objField.Function = xlCount
objField.NumberFormat = " #,##0"


Application.DisplayAlerts = True
End Sub
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Here's one way to do it:

Code:
Public Sub CreatePivotTable()
  Dim rngTableDestination As Range
  Dim rngSourceData As Range
  Dim pvc As PivotCache
  Dim pvt As PivotTable
  Dim pvf As PivotField
  
  On Error GoTo ErrHandler
' Set the range containing the source data
' and the range to locate the pivot table
  Set rngSourceData = ThisWorkbook.Sheets("OSDD").Range("A1").CurrentRegion
  Set rngTableDestination = ThisWorkbook.Sheets("Test").Range("A1")
  
  On Error Resume Next
' Delete the pivot table if it already exists
  rngTableDestination.PivotTable.TableRange2.Clear
  
  On Error GoTo ErrHandler
' Create the pivot cache and the pivot table
  Set pvc = ThisWorkbook.PivotCaches.Create(xlDatabase, rngSourceData)
  Set pvt = pvc.CreatePivotTable(rngTableDestination)
  
' Add the row and column fields
  pvt.PivotFields("Station").Orientation = xlRowField
  pvt.PivotFields("Month").Orientation = xlColumnField
  
' Add and configure the data field
  Set pvf = pvt.PivotFields("OSDD No")
  pvf.Orientation = xlDataField
  pvf.Function = xlCount
  pvf.NumberFormat = "#,##0"
  
ExitProc:
  On Error Resume Next
  Set rngTableDestination = Nothing
  Set rngSourceData = Nothing
  Set pvc = Nothing
  Set pvt = Nothing
  Set pvf = Nothing
  Exit Sub
  
ErrHandler:
  MsgBox Err.Description, vbExclamation, "Create Pivot Table"
  Resume ExitProc
End Sub
 
Upvote 0
Hi ParmaRay

Thank you for your reply, I am having a problem running the code.

It get to line "Set pvc = ThisWorkbook.PivotCaches.Create(xlDatabase, rngSourceData)"

then go to the Error "Type Mismatch"
 
Upvote 0
Ah, it worked OK when I tested it.

Please do quick test:

Select cell A1 on the sheet "OSDD" and press Ctrl+* (Ctrl+asterisk). Is the now selected range the correct source data for your pivot table?
 
Upvote 0

Forum statistics

Threads
1,215,432
Messages
6,124,858
Members
449,194
Latest member
HellScout

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top