sub test
For Each PT In ActiveSheet.PivotTables
PT.ManualUpdate = True
dt_begin = DateSerial( 2011 ,  2 ,  1 )
number_iterations = dt - dt_begin

With PT.PivotFields("[Календарь].[Календарь]")
    .CubeField.EnableMultiplePageItems = False
End With
    With PT.PivotFields("[Календарь].[Календарь]")
        .CurrentPageName = "[Календарь].[Календарь].[День].&[" & Format(dt, "yyyymmdd") & "]"
        .CubeField.EnableMultiplePageItems = True
            For i =  0  To number_iterations
                dt1 = dt - i
                dt1 = Format(dt1, "yyyymmdd")
                    .AddPageItem "[Календарь].[Календарь].[День].&[" & dt1 & "]"
'                   "[Календарь].[Календарь].[День].&[" & Format(Date, "yyyymmdd") & "]"
                 
            Next i
    End With
PT.ManualUpdate = False
Next PT
end sub