Изменение источника данных сводных таблиц с помощью VBA

Изменение источника данных сводных таблиц с помощью VBA

Я ищу код, который может изменить источник данных моих сводных таблиц с одного листа на другой источник данных. Лист источника данных идентичен, только с другими данными.

У меня есть код, который я взял из интернета, но вместо того, чтобы изменить источник данных моего активного листа, он меняет источник данных на всех моих листах.

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

Option Explicit

Sub ChangeDataSourceForAllPivotTables()

    Dim wb                  As Workbook
    Dim ws                  As Worksheet
    Dim pt                  As PivotTable
    Dim rSourceData         As Range

    If ActiveWorkbook Is Nothing Then Exit Sub

    On Error GoTo ErrHandler

    Set wb = ActiveWorkbook

    Set rSourceData = wb.Worksheets("Sheet1").Range("A1").CurrentRegion 'change the name of the worksheet accordingly

    For Each ws In wb.Worksheets
        For Each pt In ws.PivotTables
            pt.ChangePivotCache wb.PivotCaches.Create(xlDatabase, rSourceData.Address(, , , True))
            pt.RefreshTable
        Next pt
    Next ws

ExitTheSub:
    Set wb = Nothing
    Set ws = Nothing
    Set pt = Nothing
    Set rSourceData = Nothing

    Exit Sub

ErrHandler:
    MsgBox "Error " & Err.Number & ":  " & Err.Description, vbCritical, "Error"
    Resume ExitTheSub

End Sub

Заранее спасибо за помощь!

решение1

Этот код поможет вам изменить исходные данные для всех сводных таблиц на определенном листе.

Sub ChangePivotSourceData()

Dim pt As PivotTable

For Each pt In ActiveWorkbook.Worksheets("Sheet1").PivotTables
         pt.ChangePivotCache ActiveWorkbook.PivotCaches.Create _
            (SourceType:=xlDatabase, SourceData:="MyData")
Next pt

End Sub

Как это работает:

  • Copy& Pasteэтот Кодекс как Standard Module.
  • Sheetи Source Dataимена можно редактировать.
  • В этом кодеМои данныеэтоИменованный диапазон, которые вам нужно создать, прежде чем выБЕГАТЬ этот Код каждый раз, когда вы хотите изменитьИсходные данные для сводной таблицы.

решение2

Я хотел бы разделить документ по месту назначения (например) и автоматически создать различные определенные файлы (для каждого места назначения) с соответствующей сводной диаграммой. Как сделать, чтобы обновлять источник данных новых сводных диаграмм каждый раз (Испания, Италия, Франция...)? Поскольку они сохраняют исходный источник данных со всеми местами назначения (Европа). Спасибо

Dim pt As PivotTable
    Dim MyData As Excel.ListObject
   
    Set MyData = Application.Range(Europe).ListObject
   
For Each pt In ActiveWorkbook.Worksheets("Chart - City").PivotTables
         pt.ChangePivotCache ActiveWorkbook.PivotCaches.Create _
            (SourceType:=xlDatabase, SourceData:="MyData")
Next pt

Связанный контент