Ошибка при создании VBA для изменения источника данных в нескольких сводных таблицах

Question

Я пытаюсь создать VBA для изменения источника данных в нескольких сводных таблицах в одном файле данных и на листе.Источник данных находится в другой рабочей книге и еженедельно обновляется новыми данными.

"FY 18.xlsb" - Рабочая тетрадь с данными

"Данные" - рабочая таблица в "FY 18.xlsb", содержащаяКогда данные

«Сводная таблица» - рабочая таблица в активной рабочей книге, в которой находятся сводные таблицы, которые необходимо обновить.

Либо я хочу, чтобы VBA нашел конечную точку в рабочей таблице данныхили иметь всплывающее окно, в котором я могу выбрать диапазон данных.

Остановиться при запуске Debug для кода в "pt.ChangePivotCache pc"

Любой, у кого есть идеи, что может быть не так?Или есть идеи, как обновить код?

Sub AdjustPivotDataRange()
Dim pt As PivotTable, pc As PivotCache
Dim dataSheet As Worksheet, ws As Worksheet, wks As Worksheet
Dim StartPoint As Range, dataSource As Range, NewRange As String

' Datasource workbook and worksheet
Set wkb = Workbooks("FY 18.xlsb")
Set wks = wkb.Worksheets("Data")

' Worksheet
Set ws = ActiveWorkbook.Worksheets("Pivot Table")

' Dynamically retrieve range address of data
Set StartPoint = wks.Range("A1")
Set dataSource = wks.Range(StartPoint, StartPoint.SpecialCells(xlLastCell))
NewRange = wks.Name & "!" & dataSource.Address(ReferenceStyle:=xlR1C1)

' Create new PivotCache
Set pc = ThisWorkbook.PivotCaches.Create( _
           SourceType:=xlDatabase, _
           SourceData:=NewRange)

' Loop through all tables in worksheet
For Each pt In ws.PivotTables

        ' update pivot source and refresh
        pt.ChangePivotCache pc
        pt.RefreshTable

Next pt 
End Sub

РЕДАКТИРОВАТЬ: Новый код, который делает то, что я хочу!

Sub AdjustPivotDataRange()
Dim pt As PivotTable, pc As PivotCache
Dim dataSheet As Worksheet, ws As Worksheet, wks As Worksheet
Dim StartPoint As Range, dataSource As Range, NewRange As String

' Datasource workbook and worksheet
Set wkb = Workbooks("Nordics SQI - FY 19.xlsb")
Set wks = wkb.Worksheets("Data")

' Worksheet
Set ws = ActiveWorkbook.Worksheets("Pivot Table")

' Dynamically retrieve range address of data
 Set dataSource = wks.Range("A1").CurrentRegion

' Loop through all tables in worksheet
For Each pt In ws.PivotTables

        ' update pivot source and refresh
        pt.ChangePivotCache ThisWorkbook.PivotCaches.Create( _
           SourceType:=xlDatabase, _
           SourceData:=dataSource)
        pt.RefreshTable

Next pt

End Sub

Answer 1

Нет необходимости в VBA. Просто измените исходный диапазон на таблицу Excel и переопределите ваши сводные таблицы в этой таблице, потому что таблицы являются динамическими именованными диапазонами. С этого момента ваша таблица будет автоматически расширяться для размещения новых данных, и каждый раз, когда вы обновляете только одну сводную таблицу, все они будут обновляться, так как все они используют один и тот же PivotCache.

Answer 2

Первая идея - источник данных PivotCache должен быть просто непрерывным диапазоном, поэтому попробуйте с этим:

'Set StartPoint = wks.Range("A1") 'not required
Set dataSource = wks.Range("A1").currentregion
'NewRange = wks.Name & "!" & dataSource.Address(ReferenceStyle:=xlR1C1) 'not required

' Create new PivotCache
Set pc = ThisWorkbook.PivotCaches.Create( _
           SourceType:=xlDatabase, _
           SourceData:=dataSource) '!!

РЕДАКТИРОВАТЬ в отношении отредактированного вопроса:

I 'Я не уверен, насколько эффективно создать новую сводную кэш в цикле для каждой отдельной сводной таблицы.Попробуйте, чтобы это решение было комбинацией моего первого ответа и предложенного вами решения:

Не проверено

Dim newPC as PivotCache
Set newPC = ThisWorkbook.PivotCaches.Create( _
           SourceType:=xlDatabase, _
           SourceData:=dataSource)

For Each pt In ws.PivotTables

        ' update pivot source and refresh
        pt.ChangePivotCache newPC
        pt.RefreshTable

Next pt