the workbook: In my workbook the user completes a table with data. When clicking a command button the VBA code (see below) updates a PivotTable on another worksheet and then splits this table into different worksheets based on the different values filled in the pivotfield " Monstertype " (each pivotitem in that pivotfield becomes a new sheet with that table). These sheets are later transferred to a word document.
The problem: On the first trial the first pivotitem to encounter was called "Hygiene control", it then worked fine. On later trials it keeps looking for the pivotitem "Hygiene control" even if its not there anymore, with as a result I receive the error that it falls outside the subscript.
Sub exportPivot()
Application.ScreenUpdating = False
Worksheets("Blad9").PivotTables("Draaitabel17").RefreshTable
Dim wbbron As Workbook
Dim wbdoel As Workbook
Dim shtbron As Worksheet
Dim shtdoel As Worksheet
Dim pvt As PivotTable
Dim pi As PivotItem
Set wbbron = ActiveWorkbook
Set shtbron = wbbron.Sheets("Blad9")
Set pvt = shtbron.PivotTables("Draaitabel17")
pvt.ShowPages Pagefield:="Monstertype"
Set wbdoel = Workbooks.Add
For Each pi In pvt.PageFields("Monstertype").PivotItems
wbbron.Sheets(pi.Value).Move after:=wbdoel.Sheets(wbdoel.Sheets.Count)
Next pi
Application.DisplayAlerts = False
wbdoel.Sheets(1).Delete
Application.DisplayAlerts = True
VulOfferte wbdoel
End Sub
The error occurs on
wbbron.Sheets(pi.Value).Move after:=wbdoel.Sheets(wbdoel.Sheets.Count)
the cry for help: It drives me crazy, please help.
The code below will loop through PivotItems
in PivotField
" Monstertype ", and will copy a Worksheet to the added Workbook for each Item with its' CurrentPage.
Sub exportPivot()
Dim wbbron As Workbook
Dim wbdoel As Workbook
Dim shtbron As Worksheet
Dim shtdoel As Worksheet
Dim SrcData As Range
Dim pvt As PivotTable
Dim PvtCache As PivotCache
Dim PvtFld As PivotField
Dim pi As PivotItem
Application.ScreenUpdating = False
Set wbbron = ActiveWorkbook
Set shtbron = wbbron.Sheets("Blad9")
' added a Range to dynamic read new rows that were added to the source data of the Pivot Table
' modify "Sheet1" to your Sheet's name (where the Pivot Table data is located)
Set SrcData = Sheets("Sheet1").Range("A1:C" & Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row)
' set Pivot Cache to updated Pivot Table Source Data
Set PvtCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, SrcData)
Set pvt = shtbron.PivotTables("Draaitabel17")
pvt.ChangePivotCache PvtCache ' set updated Cache to Pivot Table
pvt.RefreshTable
Set PvtFld = pvt.PivotFields("Monstertype")
Set wbdoel = Workbooks.Add
' loop through all Pivot Items in Pivot Field "Monstertype" , and copy a new Sheet to added workbook for every item
For Each pi In PvtFld.PivotItems
PvtFld.CurrentPage = pi.Name
shtbron.Copy after:=wbdoel.Sheets(wbdoel.Sheets.Count)
With ActiveSheet
.Name = pi.Name
pi.Visible = True
'PvtFld.CurrentPage = pi.Name
End With
' wbbron.Sheets(pi.Name).Copy after:=wbdoel.Sheets(wbdoel.Sheets.Count)
Next pi
Application.DisplayAlerts = False
wbdoel.Sheets(1).Delete
' you can remove also sheets(2) and (3) if you want to clean-up
'wbdoel.Sheets(2).Delete
'wbdoel.Sheets(3).Delete
Application.DisplayAlerts = True
' don't know this command (NOT IN ENGLISH)
'VulOfferte wbdoel
End Sub
This looks like your pivot table retains items deleted from the data source section. This is not a problem of your VBA code, which looks fine to me. You can change this by right clicking any cell of your pivot table, select "Pivot Table Options". Then click on the "data" tab and change "Retain items deleted from the data source section" to "None".
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.