Sub SourceData_pt_main(ByVal bln_SaveData As Boolean, _

ByVal bln_RefreshOnFileOpen As Boolean)

'Call SourceData_pt_main(bln_SaveData:=True, bln_RefreshOnFileOpen:=False)

'определяем источник основной таблицы для переброски с нее кеша на остальные в книге

Dim PTCache As PivotCache

Dim oPt_Main As PivotTable

Dim oPt As PivotTable

Dim oSh As Worksheet

' On Error Resume Next

With ThisWorkbook

With .Sheets("Data")

Lng_RowEnd = .Cells(1, 256).End(xlToLeft).Column

Lng_ClnEnd = .Cells(1048576, 1).End(xlUp).row

End With

'основная таблица

Set oPt_Main = ThisWorkbook.Sheets("pt_main").PivotTables(1)

With oPt_Main

.SourceData = "Data!R1C1:R" & Lng_ClnEnd & "C" & Lng_RowEnd

.SaveData = bln_SaveData

.PivotCache.RefreshOnFileOpen = bln_RefreshOnFileOpen

.PivotCache.MissingItemsLimit = 0 'xlMissingItemsNone=0, '1048576=максимум 'xlMissingItemsDefault=Авто

End With

'переброска кеша

For Each oSh In ThisWorkbook.Sheets

For Each oPt In oSh.PivotTables

'перекидываем кеш (по индексу) 'http://www.excelforum.com/l/735371-asdf.html

oPt.CacheIndex = oPt_Main.CacheIndex

Next oPt

Next oSh

End With

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' >>> binarytopic.com <<< '

' coded by Diego F.C. '

' http://binarytopic.com/optimizar-velocidad-de-calculo-de-excel-vba/ '

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit

Sub optimizaExcel(Activar As Boolean, Optional Agresivo As Boolean = False)

'Optimiza Excel para agilizar la velocidad de calculo y evitar bloqueos de por

' refresco de pantalla, consumo de memoria...

' >>>> binarytopic.com <<<<<

' ARGUMENTOS:

' Activar: Boolean. Activa o desactiva los parametros a optimizar.

' Aggresivo: Boolean. Habilita la otimizacion de forma agresiva. Deshabilita

' cache de tablas dinamicas, guardado de datos...

Dim WS As Worksheet

Dim PVT As PivotTable

If Activar Then

Call EventsChange(False)

If Agresivo Then

For Each WS In ThisWorkbook.Worksheets

If ThisWorkbook.PivotCaches.Count > 1 Then

For Each PVT In WS.PivotTables

PVT.CacheIndex = 1

PVT.SaveData = False

Next PVT

End If

Next WS

End If

Else

Call EventsChange(True)

End If

End Sub