工作簿: 在我的工作簿中,用户使用数据完成一个表。单击命令按钮时,VBA代码(参见下文)更新另一个工作表上的数据透视表,然后根据pivotfield“ Monstertype ”中填充的不同值将此表拆分为不同的工作表(每个工作表中的每个工作表) pivotfield成为该表的新工作表。这些工作表稍后将转移到word文档。
问题: 在第一次试验中,遇到的第一个枢轴点被称为“卫生控制”,然后工作正常。在以后的试验中,它一直在寻找枢纽“卫生控制”,即使它不再存在,结果我收到它不在下标之外的错误。
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
错误发生在
上wbbron.Sheets(pi.Value).Move after:=wbdoel.Sheets(wbdoel.Sheets.Count)
寻求帮助的呼声: 它让我发疯,请帮助。
答案 0 :(得分:0)
以下代码将在PivotItems
" Monstertype "中循环显示PivotField
,并将工作表复制到每个项目的已添加工作簿中其'当前页。
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
答案 1 :(得分:0)
这看起来像您的数据透视表保留从数据源部分删除的项目。这不是你的VBA代码的问题,这对我来说很好。 您可以通过右键单击数据透视表的任何单元格来更改此设置,选择“数据透视表选项”。然后单击“数据”选项卡并将“保留从数据源部分删除的项目”更改为“无”。