Sub ListPivotsInfor()'Update 20141112
    Dim St As Worksheet
    Dim NewSt As Worksheet
    Dim pt As PivotTable
    Dim I, K As Long
    Application.ScreenUpdating = False
    Set NewSt = Worksheets.Add
    I = 1: K = 2
    With NewSt
        .Cells(I, 1) = "Name"
        .Cells(I, 2) = "Source"
        .Cells(I, 3) = "Refreshed by"
        .Cells(I, 4) = "Refreshed"
        .Cells(I, 5) = "Sheet"
        .Cells(I, 6) = "Location"
        For Each St In ActiveWorkbook.Worksheets
            For Each pt In St.PivotTables
                I = I + 1
                .Cells(I, 1).Value = pt.Name
                .Cells(I, 2).Value = pt.SourceData
                .Cells(I, 3).Value = pt.RefreshName
                .Cells(I, 4).Value = pt.RefreshDate
                .Cells(I, 5).Value = St.Name
                .Cells(I, 6).Value = pt.TableRange1.Address
            Next
        Next
        .Activate
    End With
    Application.ScreenUpdating = True
End Sub

.Cells(I, 1).Parent.Hyperlinks.Add Anchor:=.Cells(I, 1) 
 Address:="" 
 SubAddress:="'" + St.Name + "'!" + Split(pt.TableRange1.Address, ":")(0) 
 TextToDisplay:=pt.Name 
   With 
      .Cells(I, 7).Font .ColorIndex = xlAutomatic .Underline = xlUnderlineStyleNone 
   End with 
   With 
     .Cells(I, 7). 1).Characters(Start:=4165632, Length:=Len(pt.Name)).Font.Underline = xlUnderlineStyleSingle.Color = -XNUMX 
   End With

Sub test()
  Dim arrA
  Dim arrB
  
  arrA = Range("A1:A9").Value
  arrB = Filter(arrA, "январь")
  Range("B1").Resize(UBound(arrB)) = arrB
    
End Sub

Sub test()
  Dim arrA(3) As String
  Dim arrB As Variant
  arrA(1) = "a"
  arrA(2) = "b"
  arrA(3) = "c"
  arrB = Filter(arrA, "b")
End Sub

Sub xx()
Dim i As Long
Dim x As Long
x = 2
For i = 1 To x
Range("A" & i).Value = 1
x = 10

Next i