Sub TestPivotTable()
Dim shName$
Dim wbname$
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim ikv As Long


    wbname = Application.ActiveWorkbook.Name
    shName = "СВОД_query"
    Call CreateList(shName, True) ' - Создаем лист куда записываем сводную таблицу
    Call PivotTableQuery(wbname, shName) ' - процедура создает сводную таблицу
Set pt = Worksheets(shName).PivotTables(1) '- обращаемся к сводной таблице
        ' - Для первого поля
        With pt
             Set pf = pt.PivotFields(1)
             Set pi = pf.PivotItems
             For ikv = 1 To pi.Count
                 ' -Скопировать данные
             Next ikv
        End With
        ' - Для второго поля
        With pt
             Set pf = pt.PivotFields(2)
             Set pi = pf.PivotItems
             For ikv = 1 To pi.Count
                 ' -Скопировать данные
             Next ikv
        End With
end sub