change pivot table source data using vba

p4nny

Board Regular
Joined
Jan 13, 2015
Messages
246
Hi,

I would like to change the source data of my pivot table, from one location to another.

The new data is in a different location.

appreciate any guidance

Thank you
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Let's say that Sheet1 contains the new data start at A1, and that Sheet2 contains the pivot table named "PivotTable1", try...

<font face=Calibri><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN><br><br><SPAN style="color:#00007F">Sub</SPAN> ChangeSourceData()<br><br>    <SPAN style="color:#00007F">Dim</SPAN> rSourceData <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> LastRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> LastCol <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    <SPAN style="color:#00007F">With</SPAN> Worksheets("Sheet1") <SPAN style="color:#007F00">'change the sheet name accordingly</SPAN><br>        <SPAN style="color:#00007F">With</SPAN> .UsedRange<br>            LastRow = .Rows.Count + .Rows(1).Row - 1<br>            LastCol = .Columns.Count + .Columns(1).Column - 1<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        <SPAN style="color:#00007F">Set</SPAN> rSourceData = .Range("A1", .Cells(LastRow, LastCol))<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        <br>    <SPAN style="color:#00007F">With</SPAN> Worksheets("Sheet2").PivotTables("PivotTable1") <SPAN style="color:#007F00">'change the sheet and pivot table names accordingly</SPAN><br>        .ChangePivotCache ActiveWorkbook.PivotCaches.Create( _<br>            SourceType:=xlDatabase, _<br>            SourceData:=rSourceData)<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

Hope this helps!
 
Upvote 0
Many thanks for your response.. I'm a complete novice with VBA.. would kindly mind add the info below to your code? very much appreciated..

The tab where my pivot table is called "James Campbell" (sheet 18) and it is pivot table 6..

The original data source is on tab "Data download" and is in range A:T

The new data source will be on tab "hardcoded data" and is in range DZ:ER
 
Upvote 0
Try...

<font face=Calibri><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN><br><br><SPAN style="color:#00007F">Sub</SPAN> ChangeSourceData()<br><br>    <SPAN style="color:#00007F">Dim</SPAN> rSourceData <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> LastRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> LastCol <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    <SPAN style="color:#00007F">With</SPAN> Worksheets("hardcoded data")<br>        LastRow = .Cells(.Rows.Count, "DZ").End(xlUp).Row<br>        <SPAN style="color:#00007F">Set</SPAN> rSourceData = .Range("DZ1:ER" & LastRow)<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        <br>    <SPAN style="color:#00007F">With</SPAN> Worksheets("James Campbell").PivotTables("PivotTable6")<br>        .ChangePivotCache ActiveWorkbook.PivotCaches.Create( _<br>            SourceType:=xlDatabase, _<br>            SourceData:=rSourceData)<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

Hope this helps!
 
Upvote 0
Hi sorry to bother you again..

the code works great alone... however I'm trying to add it the code below..

My idea would be to add your code before the SaveAs. I'm getting a message saying invalid call or procedure. Again thanks so much


Sub exportsheets()

Dim wbNew As Workbook
Dim rngTM As Range
Dim strPath As String


On Error GoTo Errorcatch


Application.ScreenUpdating = False


strPath = "C:\Users\pandoan\Desktop\test\"
Set rngTM = Sheets("Flow TM's").Range("A1")


Do
Sheets(Array("Hardcoded data", rngTM.Value)).Copy
Set wbNew = ActiveWorkbook
With wbNew
.Sheets("Hardcoded data").Visible = True

Range("F5:G5", "T3:U3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("B2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

wbNew.SaveAs strPath & rngTM & Format(Date, "ddmmmyyyy") & ".xlsm", FileFormat:=52

ActiveWorkbook.Close


End With
Set rngTM = rngTM.Offset(1, 0)
Loop Until IsEmpty(ActiveCell) = True

Application.ScreenUpdating = True



Errorcatch:
MsgBox Err.Description


End Sub
 
Upvote 0
When the error occurs, which line of code is highlight? (Note that you'll need to comment out or remove the error handling.) Also, can you post the complete code that you tried?
 
Upvote 0
Hi - The code works great in a standalone workbook. What I'm trying to do is basically add your code to my existing code that is designed to export a number of worksheets including hardcoded data from a workbook. The pivots within the worksheets are linked to data within the workbook however I'm wanting use your code to change the data source of the pivot to look within the newly created workbook. Rather than specifying the worksheets (James Campbell) I would it follow my code in the loop. Hope that makes sense, Hope you can follow the code. thank you!!

ub exportsheets()

Dim wbNew As Workbook
Dim rngTM As Range
Dim strPath As String
Dim rSourceData As Range
Dim LastRow As Long
Dim LastCol As Long




On Error GoTo Errorcatch


Application.ScreenUpdating = False


strPath = "C:\Users\pandoan\Desktop\test\"
Set rngTM = Sheets("Flow TM's").Range("A1")


Do
Sheets(Array("hardcoded data", rngTM.Value)).Copy
Set wbNew = ActiveWorkbook
With wbNew
.Sheets("hardcoded data").Visible = False
Application.Goto .Sheets(1).Range("B13"), True

Range("F5:G5", "T3:U3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Range("B2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False



wbNew.SaveAs strPath & rngTM & Format(Date, "ddmmmyyyy") & ".xlsm", FileFormat:=52

With Worksheets("hardcoded data")
LastRow = .Cells(.Rows.Count, "DZ").End(xlUp).Row
Set rSourceData = .Range("DZ1:ER" & LastRow)
End With

With Worksheets("Matt Wilkins").PivotTables("PivotTable6")
.ChangePivotCache ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=rSourceData)
End With

ActiveWorkbook.Save

ActiveWorkbook.Close


End With
Set rngTM = rngTM.Offset(1, 0)
Loop Until IsEmpty(ActiveCell)

Application.ScreenUpdating = True



Errorcatch:
MsgBox Err.Description


End Sub
 
Upvote 0
Try replacing...

Code:
With Worksheets("Matt Wilkins").PivotTables("PivotTable6")

with

Code:
With Worksheets([COLOR="#FF0000"]rngTM.Value[/COLOR]).PivotTables("PivotTable6")
 
Upvote 0
thanks for the reply... The error message I'm getting is "compile error - Loop without do". I've entered the code prior to the save as. Cheers
 
Upvote 0

Forum statistics

Threads
1,223,243
Messages
6,170,971
Members
452,371
Latest member
Frana

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