Ну и последний вариант ) Уже попробовал на данных самостоятельно - работает.
Вообще, вслепую без данных код писать крайне сложно, вот и ошибки получаются.
Когда каждый день этим занимаешься - это одно (раньше у меня это получалось), а я в последнее время редко программирую,вот и получаются мелкие баги.
Код:
Sub rmk()
Dim ptTable As PivotTable, pvtField As PivotField, cl As Long, rw As Long, i As Long
Application.ScreenUpdating = 0
For Each ptTable In ActiveSheet.PivotTables
With ptTable
If Not (Intersect(.TableRange1, Selection) Is Nothing) Then
For Each pvtField In .DataFields
If Not (Intersect(pvtField.DataRange, Selection) Is Nothing) Then
On Error Resume Next
pvtField.Caption = Split(pvtField.Name, "полю")(1)
pvtField.Function = xlSum
pvtField.NumberFormat = "0"
End If
Next
Exit Sub
End If
End With
Next
Application.ScreenUpdating = 1
End Sub Кстати, если удалить строку "Exit Sub", то можно будет обрабатывать за один раз сразу несколько таблиц, если в них одновременно выделить нужные поля. А при текущем раскладе будет обработана лишь первая попавшаяся сводная таблица, которая имеет хотя бы одно выделенное поле.