Question

我试图将4个枢轴行标签数据复制到另一个称为“ RSL进行审核”的工作表中，一次又一次地复制其他枢轴行标签数据。我只能复制一个枢轴数据，但其中的数据太完整了，并且在没有循环的情况下也没有错误。

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

Answer 1

PivotTable.PivotSelect的参数“ Mode”必须为xlLabelOnly而不是“ xlLabel”（请参见here）。

您最后一次使用的行（“ LR”）的计算必须在目标工作表上进行-并且直接在每次粘贴操作之前进行。

请首先尝试：

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参数Paste更改为xlPasteValuesAndNumberFormats或任何需要的参数。如果粘贴xlPasteAll或xlPasteAllUsingSourceTheme，则目标位置也会有数据透视表（如果它们相互重叠，则会出现错误）。

在与PivotSelect一起复制选定范围时，该表必须处于活动状态（激活）。每个人都尝试avoid selecting or activating anything时，有一个更好的解决方案。

您可以通过此方法复制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

我正在尝试将4个数据透视表的rowlabel一张一张地复制到另一张纸上

1 个答案: