RE: copy paste entire pivot data Using VBA

Hi all,

Need your help on the topic -copy entire pivot data and paste as values using VBA. Tried out macro recording as well but it shows code of usual copy paste in VBA. Also attached the dummy data for your reference

Help Required:

I have a pivot table in range from (A: E). I need to Copy and paste the entire pivot in column I to M and again paste the same pivot below with opposite sign for values of Total column and ignore "Units" column in column L.

Region

Rep

Item

Units

Sum of Total ->pivot headers

Thanks for your help in advance.

Code:

---

Sub blah()
Set pt = Range("A3").PivotTable    'note that cell A3 is any cell within the pivot table.
Set Tablerange = pt.TableRange1
Set Destn1 = Tablerange.Offset(, Tablerange.Columns.Count + 3)
Destn1.Value = Tablerange.Value
Set Destn2 = Destn1.Offset(Tablerange.Rows.Count + 3).Resize(, Tablerange.Columns.Count - 1)
UnitsColm = Application.Match("Units", Destn1.Rows(1), 0)
If UnitsColm = Destn1.Columns.Count Then
  Set SourceRng = Destn1.Resize(, Destn1.Columns.Count - 1)
Else
  Set SourceRng = Union(Destn1.Resize(, UnitsColm - 1), Intersect(Destn1, Destn1.Offset(, UnitsColm)))
End If
SourceRng.Copy
Destn2.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
For Each cll In Destn2.Columns(Destn2.Columns.Count).Cells
  If IsNumeric(cll.Value) And Len(cll.Value) > 0 Then cll.Value = cll.Value * -1
Next cll
End Sub

---

Hi p45cal,

Thanks for your help. The code looks fine but facing some issues in it. If you can add little more description it would be helpful.

Also, please consider the below points to be included in the help:

1) Grand totals should not be included during copy paste.
2)I have a pivot table in range from (A: E). I need to Copy and paste the entire pivot in column I to M. Once this step is done - Based on last filled row, again paste the same pivot below with opposite sign for values of Total column(if the total values are negative then paste as positive) and ignore "Units" column in column L.

Thanks for your help in advance.

Another way

Code:

---

Option Explicit


Sub DoStuff()
    Dim pt As PivotTable
    Dim ptTable As Range, rNeg As Range, rNegRow As Range
    Dim i As Long


    Set pt = ActiveSheet.PivotTables(1)
   
    Set ptTable = pt.TableRange1
   
    With ptTable
        If pt.RowGrand Then Set ptTable = .Cells(1, 1).Resize(.Rows.Count, .Columns.Count - 1)
        If pt.ColumnGrand Then Set ptTable = .Cells(1, 1).Resize(.Rows.Count - 1, .Columns.Count)
    End With
       
    With ptTable
        .Cells(0, 1).Offset(1, .Columns.Count + 3).CurrentRegion.Clear
   
        .Copy
        .Cells(0, 1).Offset(1, .Columns.Count + 3).PasteSpecial Paste:=xlPasteValues
   
        Set rNeg = .Cells(0, 1).Offset(1, .Columns.Count + 3).CurrentRegion
        Set rNegRow = .Cells(0, 1).Offset(1, .Columns.Count + 3).End(xlDown).Offset(1, 0)
    End With
   
    Set rNeg = rNeg.Cells(2, 1).Resize(rNeg.Rows.Count - 1, rNeg.Columns.Count)
    rNeg.Copy rNegRow
   
    Set rNeg = rNeg.CurrentRegion
   
    On Error Resume Next
    For i = rNegRow.Row To rNeg.Cells(1, 1).End(xlDown).Row
        ActiveSheet.Cells(i, 13).Value = -1 * ActiveSheet.Cells(i, 13).Value
    Next i
    On Error GoTo 0
End Sub

---

More notes on a changed offering:

Code:

---

Sub blah()
Set pt = Range("A3").PivotTable    'note that cell A3 is any cell within the pivot table.
'pt is an object variable being the pivot table object and all its properties.
pt.ColumnGrand = False
Set Tablerange = pt.TableRange1 'Create a range variable called Tablerange being the entire table cell range less the Page fields (=Filters) (which you don't have anyway).
Set Destn1 = Tablerange.Offset(, Tablerange.Columns.Count + 3) 'create a range variable for where the first copying will end up.
'Offset uses Offset(no. of rows, no. of columns); the row section is left blank so there's no offset for rows, you could put a zero in instead)...
'.Columns.Count+3 means the copied data will leave 3 blank columns beyond the original pivot table.
'Destn1.Select 'enable this line so you can get a visual of where Destn1 is on the sheet when using keyboard F8 to step through the code line by line.
Destn1.Value = Tablerange.Value 'copy the values over.
pt.ColumnGrand = True
Set Destn2 = Destn1.Offset(Tablerange.Rows.Count + 3).Resize(, Tablerange.Columns.Count - 1) 'creates the range variable 3 rows below Destn1 (there's no column component in the Offset), but resize it to have one column fewer.
'UnitsColm = Application.Match("Sum of Units", Destn1.Rows(1), 0)
UnitsColm = Application.Match("Units", Destn1.Rows(1), 0) 'This just determines which column is going to be missed out; it looks for 'Units' in the first row of the first copied range.
'In case you don't have the same arrangement of columns as you have now:
If UnitsColm = Destn1.Columns.Count Then 'if the Units column is the last column
  Set SourceRng = Destn1.Resize(, Destn1.Columns.Count - 1)
Else 'if the Units column isn't the last column
  Set SourceRng = Union(Destn1.Resize(, UnitsColm - 1), Intersect(Destn1, Destn1.Offset(, UnitsColm)))
  'SourceRng.Select 'enable this line for a visual of what's going to be copied.
End If
SourceRng.Copy 'copy to clipboard
Destn2.PasteSpecial Paste:=xlPasteValues 'paste values to Destn2.
Application.CutCopyMode = False 'lose the dotted line around the copied range.
For Each cll In Destn2.Columns(Destn2.Columns.Count).Cells 'take each cell in the last column of the newly copied data (assumes that the Total column is the last column).
  If IsNumeric(cll.Value) And Len(cll.Value) > 0 And cll.Value < 0 Then cll.Value = cll.Value * -1 'if the value is numeric and not empty and less than 0 then multiply by -1 to flip from negative to positive.
Next cll
End Sub

---

re Point 1: Lines have been added to remove the grand total before copying and to reinstate it after copying has completed.
re Point 2: All that is already happening, except I've changed the line which flips values from negative to positive but now leaves positive numbers alone.

I'm not sure what you mean by ignoring 'Units' column - I've assumed you want just to miss it out rather than aggregate similar values to leave fewer rows (eg. Central|Andrews|Penci has three rows which could be aggregated to one row).

There may also be a Power Query solution.

Hi Paul,

Thanks for your quick response and help! Going forward will share the code which i worked on macros to help in my requirement in the forum as suggested by you.

The code works fine. However, the below highlighted one which i have i requested earlier is missing in your code.

I have a pivot table in range from (A: E). I need to Copy and paste the entire pivot in column I to M. Once this step is done - Based on last filled row, again paste the same pivot below with opposite sign for values of Total column(if the total values are negative then paste as positive) and ignore "Units" column in column L.

Please Help out.


Thanks for your support in advance

Paul, an interesting gotchya with your:

Code:

---

With ptTable
  If pt.RowGrand Then Set ptTable = .Cells(1, 1).Resize(.Rows.Count, .Columns.Count - 1)
  If pt.ColumnGrand Then Set ptTable = .Cells(1, 1).Resize(.Rows.Count - 1, .Columns.Count)
End With

---

Add some select statements and step through it:

Code:

---

With ptTable
  If pt.RowGrand Then Set ptTable = .Cells(1, 1).Resize(.Rows.Count, .Columns.Count - 1)
  ptTable.Select
  .Select
  If pt.ColumnGrand Then Set ptTable = .Cells(1, 1).Resize(.Rows.Count - 1, .Columns.Count)
  ptTable.Select
  .Select
End With

---

RowGrand is True in the supplied pivot, so after the first If, the ptTable becomes one column fewer.
ColumnGrnd is also True, but because the subsequent Set statement uses the With version of ptTable (which doesn't change at all within the confines of the With…End With), the .Columns.Count is the width of the original pivot!
To correct that we'd need to use the new ptTable instead of the With…End With version thus:

If pt.ColumnGrand Then Set ptTable = .Cells(1, 1).Resize(.Rows.Count - 1, ptTable.Columns.Count)

(RowGrand being true doesn't show an extra column on this pivot because of the orientation of the pivot (had all the items which are currently in the Rows section of the pivot been in the Columns section we'd have seen row grand totals).
So in this instance we'd end up with a range to copy which is short of a column but as luck would have it the RowGrand line is effectively ignored in your original code! To get round this we should turn off grand totals, do the copying, then restore them:

Code:

---

OriginalRowGrand = pt.RowGrand
OriginalColumnGrand = pt.ColumnGrand
pt.RowGrand = False
pt.ColumnGrand = False

'do the copying

pt.RowGrand = OriginalRowGrand
pt.ColumnGrand = OriginalColumnGrand

---

Yea, missed that:banghead:, but as you said I lucked out, and in this case, two wrongs did make a right :devil2:

Attachment 27162

Hi p45cal,

Thanks for your response. Also, thanks for updating your code with points which i have highlighted. Regarding your point, i have provided:

I'm not sure what you mean by ignoring 'Units' column - I've assumed you want just to miss it out rather than aggregate similar values to leave fewer rows (eg. Central|Andrews|Penci has three rows which could be aggregated to one row). - I have stated to ignore Units column which means we have to copy and paste the pivot again below the first step (entire pivot data copy and paste)as values we have to ignore units column( leave it Empty/blank cells) and pasting total columns with opposite sign( All that is already happening, except I've changed the line which flips values from negative to positive but now leaves positive numbers alone - done by Paul code) .


Attached the sample output which i have requested as help in form of image for your reference.

Code:

---

Sub blah2()
Set pt = Range("A3").PivotTable    'note that cell A3 is any cell within the pivot table.
OriginalRowGrand = pt.RowGrand
OriginalColumnGrand = pt.ColumnGrand
pt.RowGrand = False
pt.ColumnGrand = False
Set Tablerange = pt.TableRange1
Set Destn1 = Tablerange.Offset(, Tablerange.Columns.Count + 3)
Destn1.Value = Tablerange.Value
pt.RowGrand = OriginalRowGrand
pt.ColumnGrand = OriginalColumnGrand
Set SourceRng = Intersect(Destn1, Destn1.Offset(1))
Set Destn2 = SourceRng.Offset(SourceRng.Rows.Count)
UnitsColm = Application.Match("Units", Destn1.Rows(1), 0)
SourceRng.Copy Destn2
Destn2.Columns(UnitsColm).ClearContents
For Each cll In Destn2.Columns(Destn2.Columns.Count).Cells
  If IsNumeric(cll.Value) And Len(cll.Value) > 0 Then cll.Value = Abs(cll.Value)
Next cll
End Sub

---

I'd use:

Code:

---

Sub M_snb()
  With Sheet1.PivotTables(1).TableRange1
      .Copy Sheet1.Cells(3, 9)
      .Copy Sheet1.Cells(.Rows.Count + 6, 9)
  End With
 
  With Sheet1.PivotTables(1)
        .PivotFields("Units").Orientation = 0
        .PivotFields("Sum of Total").Orientation = 0
        .CalculatedFields.Add("inversion", "= -1*Total").Orientation = 4
  End With
End Sub

---

hi p45cal,

Attachment 27164

The code works completely fine now in dummy data which i shared with you. Attached the image of original data pivot headers for your reference.


When i applied the same code in original data facing error. I have also changed the range of pivot from A3 to A4 in the first line of your code. Also, renamed the units column with name "TP". still Facing error at the line highlighted below:


UnitsColm = Application.Match("TP", Destn1.Rows(1), 0) 'This just determines which column is going to be missed out; it looks for 'Units' in the first row of the first copied range -> Replaced units with TP column name
SourceRng.Copy Destn2 ' Need to understand this line what it does
Destn2.Columns(UnitsColm).ClearContents -> Facing error here -> Run time error '13' Type mistmatch
For Each cll In Destn2.Columns(Destn2.Columns.Count).Cells 'take each cell in the last column of the newly copied data (assumes that the Total column is the last column).
If IsNumeric(cll.Value) And Len(cll.Value) > 0 Then cll.Value = Abs(cll.Value) 'if the value is numeric and not empty and less than 0 then multiply by -1 to flip from negative to positive.
Next cll
End Sub


Kindly help out. Hope this would be the final help required from my end in this thread.


Thanks for your support in advance.

It's not finding TP because it's looking in the first row of copied data, but your new pivot contains an added header 'Sum of Items Value' above the columns headers, which implies there may be something in the columns field.
You really ought to attach the real thing or a more accurate representation of the real thing as a workbook.
A quick fix might be:
UnitsColm = Application.Match("TP", Destn1.Rows(2), 0)
but it would probably mess up elsewhere.

Code:

---

SourceRng.Copy Destn2

---

just copy/pastes SourceRng to Destn2
Add the lines:

Code:

---

SourceRng.select
Destn2.Select

---

before the copying line and step throuigh the code with F8 on the keyboard to see what those areas are.

Hi p45cal,

As per your suggestion already i step through the code and understood it.
Also changed the line which refers TP column: UnitsColm = Application.Match("TP", Destn1.Rows(2), 0)

The code works absolutely fine which helped to fix my request. Thank you so much - p45cal for sharing your suggestions and code and sorry for annoying much by posting multiple requests from my end.:yes


Thanks a lot to each of you for your kind suggestions and help .