1

I'm trying to copy 4 pivot row labels data to another sheet called "RSL to Review" one after other pivot row label data. I am able to copy only one pivot data that too whole data and no error after that no loop works.

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

Result should be platform (pivot row label)

Region  Platform
APJ Barit/Bucci
APJ Cannonball 1.0
APJ EvansDG
Asger
  • 3,822
  • 3
  • 12
  • 37
reshmi22 reshmi
  • 13
  • 6
  • Could it be because you are using `Select`? This is not necessary to copy/paste things. `Selection.Copy Sheets("RSL to Review").Range("b" & LR + 2)` should also work. – Alex de Jong Jun 24 '19 at 10:50
  • if i use selection.copy gives error . – reshmi22 reshmi Jun 24 '19 at 10:54
  • Do I have to guess the error? :) – Alex de Jong Jun 24 '19 at 10:57
  • Object doesnt support thisproperty or method – reshmi22 reshmi Jun 24 '19 at 11:00
  • Have you put my suggested code in one line or is it on two lines? I would expect this error if you put it on two lines. It should be on one. – Alex de Jong Jun 24 '19 at 11:01
  • Sheets("RSL to Review").Range("b" & LR + 2).Selection.Copy – reshmi22 reshmi Jun 24 '19 at 11:02
  • That's not what I wrote :). `Selection.Copy Sheets("RSL to Review").Range("b" & LR + 2)` on the place where you now only used `Selection.copy` and you can get rid of the three lines below. – Alex de Jong Jun 24 '19 at 11:14
  • :(we cant make this change for the selected cells because it will affect a ivot table. use the field list to change the report .if you are trying to insert or delete cells ,move the pivot table and try again- error – reshmi22 reshmi Jun 24 '19 at 11:23
  • im not understanding as we are making changes in the worksheet where we dont have pivot table why is this error coming Alex – reshmi22 reshmi Jun 24 '19 at 11:26
  • I don't follow you I'm sorry. If you can't use my suggestion, then I don't know. It doesn't delete anything, it just prevents you from activating another sheet. Other than that it should do the same as your current code. – Alex de Jong Jun 24 '19 at 11:34
  • i used your suggestion and it gave the above error which i had mentioned. this is the error which i got "we cant make this change for the selected cells because it will affect a pivot table. use the field list to change the report .if you are trying to insert or delete cells ,move the pivot table and try again" – reshmi22 reshmi Jun 24 '19 at 11:48
  • it run time error 1004 – reshmi22 reshmi Jun 24 '19 at 11:50

1 Answers1

0

The parameter "Mode" for PivotTable.PivotSelect has to be xlLabelOnly and not "xlLabel" (see here).

Your calculation of the last used row ("LR") has to be performed on the destination sheet - and directly before each paste operation.

Please try this first:

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

You may change the Range.PasteSpecial parameter Paste to xlPasteValuesAndNumberFormats or whatever needed. If you paste xlPasteAll or xlPasteAllUsingSourceTheme you also have pivottables at the destination (and an error, if they would overlap each other).

As you work with PivotSelect to copy the selected range, that sheet must be active (activated) before. As everybody tries to avoid selecting or activating anything, there is a better solution.

You can copy RowFields().LabelRange or RowFields().DataRange (or both by Union) by this without selecting or activating anything:

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
Asger
  • 3,822
  • 3
  • 12
  • 37