VBA Детализирует сводную таблицу и отображает результаты на выделенном листе

#excel #vba

#превосходить #vba

Вопрос:

Хороший день,

У меня был запрос от клиента о том, что, когда они детализируют значение в сводной таблице, отфильтрованные результаты не продолжают открывать новые листы, скорее, им нужен один выделенный лист, куда будут помещаться эти данные. Сводная таблица находится в названии листа: IncomeStatement, а выделенный лист результатов называется детализацией.

Мой приведенный ниже код отлично работает для обычной сводной таблицы — очищает содержимое на детализированном листе, а затем загружает новые данные.

У меня возникли проблемы с адаптацией этой же функции к сводной таблице, которая теперь является частью модели данных. При запуске лист детализации остается пустым.

Есть какие-нибудь идеи о том, чего мне не хватает?

Мой код:

Модуль1

 Public CS$  

Эта Рабочая тетрадь

 Private Sub Workbook_NewSheet(ByVal Sh As Object) If CS lt;gt; "" Then With Application  ScreenUpdating = False  Dim NRamp;  With Sheets("DrillDown")   'Set this to always start at the top of the page  NR = 1  '..and to clear the Drilldown tab..  .Cells.ClearContents   'instead of this..  ' If WorksheetFunction.CountA(.Rows(1)) = 0 Then  ' NR = 1  'Else  ' NR = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row   2  'End If   Range("A1").CurrentRegion.Copy .Cells(NR, 1)   End With  .DisplayAlerts = False  ActiveSheet.Delete  .DisplayAlerts = True  'Below is commented out to stop user being returned to Pivot  ' Sheets(CS).Select  .ScreenUpdating = True  End With End If End Sub   Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) If ActiveSheet.Name = "IncomeStatement" Then CS = "IncomeStatement" ElseIf ActiveSheet.Name = "DrillDown" Then If Not IsEmpty(Target) Then If Target.Row gt; Range("A1").CurrentRegion.Rows.Count   1 _ Or Target.CurrentRegion.Cells(1, 1).Address = "$A$1" Then Cancel = True With Target.CurrentRegion .Resize(.Rows.Count   1).EntireRow.Delete End With End If End If End If End Sub