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

reshmi22 reshmi

我试图将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

阿斯格

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

您必须在目标表上以及在每次粘贴操作之前直接计算最后使用的行（“ 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 toxlPasteValuesAndNumberFormats或任何需要的参数。如果粘贴，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

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。