Hi helping folks and gods of coding.
As a newbee in vba codes without any deeper knowledge I check forums like this to find answers to what I have done wrong. But for this problem I have not found a fittig solution or at least any I could crasp. So I have to ask dirctly and hope for helpfull answers.
ATM I'm working on a vba code to copy multiple sheets containing pivot charts/tables with and without data slicers as well as their data source to a new workbook.
All pivot share the same data source organised as a table (Listobject). That code worked fine until I discovered that the pivots still refered to the original workbook.
I searched the internet and found at TheSpreadsheetGuru.com a solution to change the PivotCache via vba. That code on itself worked fine too, if run directly in the new workbook. So i tried to implement the changing of the PivotCache into the code to copy the sheets to the new worksheet. The result was folowing code:
Private Sub cmdTest_Click()
' Copy worksheets and change PivotCache
'SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault (part of code for PivotCache change)
' Variables for loop
Dim wb As Workbook
Dim ws As Worksheet
Dim pt As PivotTable
' Variables for changing PivotCache
Dim Data_sht As Worksheet
Dim Pivot_sht As Worksheet
Dim PivotName As String
Dim NewRange As String
Dim Source As String
' Variables for filename and path
Dim Path As String
Dim NewName As String
Path = ActiveWorkbook.Path
NewName = "HH_Plan " & Worksheets("Steuerungselemente").Range("D5").Value & "_" & _
Worksheets("Steuerungselemente").Range("D7").Value & " Diagramme.xlsx"
'MsgBox ("name: " & Path & NewName)
' Copy Sheets to new Workbook
Worksheets(Array("Gesamthaushalt", "Teilhaushalt", "Planansätze", "Stammdaten")).Copy
' Set Variables for PivotCache
Set Data_sht = ThisWorkbook.Worksheets("Planansätze") 'Sheet with data source
Source = "tbl_planansatz" ' Data Source (= Table / ListObject)
NewRange = Data_sht.Name & "!" & Source ' New range for PivotCache
' Loop for PivotCache change and value format
Set wb = ActiveWorkbook
For Each ws In wb.Sheets
For Each pt In ws.PivotTables
With pt
.ChangePivotCache ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRange)
.PivotCache.Refresh
For Each pf In .DataFields
pf.NumberFormat = "#,##0 €"
Next pf
.ColumnRange.HorizontalAlignment = xlCenter
.PivotCache.Refresh
End With
Next pt
Next ws
' Loop for sheet protection (inactive for testing)
'For Each ws In wb.Sheets
' With ws
' .Protect Password:="xxx", DrawingObjects:=False, Contents:=True, Scenarios:= _
' False, AllowFiltering:=True, AllowUsingPivotTables:=True
' End With
'Next ws
' Hide Source Data sheets and workbook protection. Save to Filename and path
Worksheets(Array("Planansätze", "Stammdaten")).Visible = False
Worksheets("Gesamthaushalt").Activate
ActiveWorkbook.ShowPivotTableFieldList = False
'ActiveWorkbook.Protect Password:="xxx", Structure:=True, Windows:=False
ActiveWorkbook.SaveAs Filename:=Path & "\" & NewName
End Sub
Running the code results in an Run-Time Error 5: Invalid Procedure Call or Argument statement when hitting the line
.ChangePivotCache ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRange)
As running the code for copying without changing the PivotCache and running the PivotCache change after copying the sheets doesn't result in an error, the run-time error must be connected to the combination of both steps. I guess the changing of the PivotCache can't be done in this state of the new workbook, but I cant think of any workaround to a problem I don't understand. So I musst surrender to excel and vba.
As perhaps the one or the other might guess from the names of the sheets I normaly communicate in german
. So please excuse my partly broken and clumsy attemps or outright assaults on english language and gramma. But I hope that you can help me nontheless.
Thanks in advance and kind regards
As a newbee in vba codes without any deeper knowledge I check forums like this to find answers to what I have done wrong. But for this problem I have not found a fittig solution or at least any I could crasp. So I have to ask dirctly and hope for helpfull answers.
ATM I'm working on a vba code to copy multiple sheets containing pivot charts/tables with and without data slicers as well as their data source to a new workbook.
All pivot share the same data source organised as a table (Listobject). That code worked fine until I discovered that the pivots still refered to the original workbook.
I searched the internet and found at TheSpreadsheetGuru.com a solution to change the PivotCache via vba. That code on itself worked fine too, if run directly in the new workbook. So i tried to implement the changing of the PivotCache into the code to copy the sheets to the new worksheet. The result was folowing code:
Private Sub cmdTest_Click()
' Copy worksheets and change PivotCache
'SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault (part of code for PivotCache change)
' Variables for loop
Dim wb As Workbook
Dim ws As Worksheet
Dim pt As PivotTable
' Variables for changing PivotCache
Dim Data_sht As Worksheet
Dim Pivot_sht As Worksheet
Dim PivotName As String
Dim NewRange As String
Dim Source As String
' Variables for filename and path
Dim Path As String
Dim NewName As String
Path = ActiveWorkbook.Path
NewName = "HH_Plan " & Worksheets("Steuerungselemente").Range("D5").Value & "_" & _
Worksheets("Steuerungselemente").Range("D7").Value & " Diagramme.xlsx"
'MsgBox ("name: " & Path & NewName)
' Copy Sheets to new Workbook
Worksheets(Array("Gesamthaushalt", "Teilhaushalt", "Planansätze", "Stammdaten")).Copy
' Set Variables for PivotCache
Set Data_sht = ThisWorkbook.Worksheets("Planansätze") 'Sheet with data source
Source = "tbl_planansatz" ' Data Source (= Table / ListObject)
NewRange = Data_sht.Name & "!" & Source ' New range for PivotCache
' Loop for PivotCache change and value format
Set wb = ActiveWorkbook
For Each ws In wb.Sheets
For Each pt In ws.PivotTables
With pt
.ChangePivotCache ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRange)
.PivotCache.Refresh
For Each pf In .DataFields
pf.NumberFormat = "#,##0 €"
Next pf
.ColumnRange.HorizontalAlignment = xlCenter
.PivotCache.Refresh
End With
Next pt
Next ws
' Loop for sheet protection (inactive for testing)
'For Each ws In wb.Sheets
' With ws
' .Protect Password:="xxx", DrawingObjects:=False, Contents:=True, Scenarios:= _
' False, AllowFiltering:=True, AllowUsingPivotTables:=True
' End With
'Next ws
' Hide Source Data sheets and workbook protection. Save to Filename and path
Worksheets(Array("Planansätze", "Stammdaten")).Visible = False
Worksheets("Gesamthaushalt").Activate
ActiveWorkbook.ShowPivotTableFieldList = False
'ActiveWorkbook.Protect Password:="xxx", Structure:=True, Windows:=False
ActiveWorkbook.SaveAs Filename:=Path & "\" & NewName
End Sub
Running the code results in an Run-Time Error 5: Invalid Procedure Call or Argument statement when hitting the line
.ChangePivotCache ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRange)
As running the code for copying without changing the PivotCache and running the PivotCache change after copying the sheets doesn't result in an error, the run-time error must be connected to the combination of both steps. I guess the changing of the PivotCache can't be done in this state of the new workbook, but I cant think of any workaround to a problem I don't understand. So I musst surrender to excel and vba.
As perhaps the one or the other might guess from the names of the sheets I normaly communicate in german
. So please excuse my partly broken and clumsy attemps or outright assaults on english language and gramma. But I hope that you can help me nontheless.Thanks in advance and kind regards
