Я пытаюсь скопировать метки строк из 4 сводных таблиц один за другим на другой лист - PullRequest
Новая
       26

Я пытаюсь скопировать метки строк из 4 сводных таблиц один за другим на другой лист

1 голос
/ 24 июня 2019

Я пытаюсь скопировать данные 4 меток сводной строки на другой лист, который называется «RSL to Review», одну за другой, на метку данных сводной строки. Я могу скопировать только одну сводную информацию, которая содержит целые данные, и никакой ошибки после этого никакой цикл не работает. 

Sub Macro2()
    Dim i As Integer
    Dim LR As Integer

    For i = 1 To 4
        LR = Sheets("pivot").Range("a" & Rows.Count).End(xlUp).Row

       ' Sheets("RSL to Review").Activate

        Sheets("pivot").PivotTables("PivotTable" & i).PivotSelect "", xlLabel,true 
            Selection.Copy
        Sheets("RSL to Review").Activate
            Sheets("RSL to Review").Range("b" & LR + 2).Select
            ActiveSheet.Paste
    Next i
End Sub

Результат должен быть платформой (метка сводной строки) 

Region  Platform
APJ Barit/Bucci
APJ Cannonball 1.0
APJ EvansDG

1 Ответ

0 голосов
/ 24 июня 2019

Параметр «Режим» для PivotTable.PivotSelect должен быть xlLabelOnly, а не «xlLabel» (см. здесь ).

Ваш расчет последней использованной строки ("LR") должен выполняться на листе destination - и непосредственно перед каждой операцией вставки .

Пожалуйста, попробуйте сначала: 

Sub Macro2()
    Dim i As Integer
    Dim LR As Integer

    Sheets("pivot").Activate
    For i = 1 To 4
        Sheets("pivot").PivotTables("PivotTable" & i).PivotSelect "", xlLabelOnly, True
        Selection.Copy

        With Sheets("RSL to Review")
            LR = .Cells(.Rows.Count, "B").End(xlUp).Row
            .Cells(LR + 2, "B").PasteSpecial Paste:=xlPasteAll
        End With
    Next i
End Sub

Вы можете изменить Range.PasteSpecial параметр Вставить на xlPasteValuesAndNumberFormats или что угодно. Если вы вставите xlPasteAll или xlPasteAllUsingSourceTheme, у вас также будут сводные таблицы в месте назначения (и ошибка, если они будут перекрывать друг друга).

Когда вы работаете с PivotSelect для копирования выбранного диапазона , этот лист должен быть активным (активированным) раньше. Поскольку все пытаются избегать выбора или активации чего-либо , есть лучшее решение.

Вы можете скопировать RowFields().LabelRange или RowFields().DataRange (или оба Union), не выбирая и не активируя ничего: 

Sub CopyPivotRowlabels()
    Dim i As Long
    Dim LR As Long

    For i = 1 To 4
        With Sheets("pivot").PivotTables(i).RowFields(1)
            .DataRange.Copy
            'Union(.LabelRange, .DataRange).Copy
        End With

        With ActiveWorkbook.Sheets("RSL to Review")
            LR = .Cells(.Rows.Count, "B").End(xlUp).Row
            .Cells(LR + 2, "B").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
        End With
    Next i
End Sub
...