将 Pivot 表总计复制到下一个空单元格

Question

So I have a Pivot Table located in column N,O with a Grand Total row and I want to copy that grand total to the next empty cell in a list in Column "R". I've found a code that can copy the grand total to a cell but I can't make it work to copy it in the next empty cell.

Dim rngPvt As Range, sht As Worksheet, valToFind$, gtv
Set sht = Sheets("Sheet1")
Set rngPvt = sht.PivotTables("1").RowRange
valToFind = sht.PivotTables("1").GrandTotalName
Set gtv = rngPvt.Find(valToFind, , xlFormulas)
'assumes value to the right of field name
Sheets("Sheet1").Cells(LastRow, 18).PasteSpecial xlPasteValues = gtv.Offset(, 1)

Answer 1

Try this..

Sub test()

Dim wb As Workbook
Set wb = ThisWorkbook
Dim sh As Worksheet
Set sh = wb.Sheets("Sheet1")
Dim pt As PivotTable
Set pt = sh.PivotTables("PivotTable1")
Dim FinalPvtGT As Range
Set FinalPvtGT = pt.TableRange1(pt.TableRange1.Rows.Count, _
                            pt.TableRange1.Columns.Count)
Dim targetCell As Range
Set targetCell = FinalPvtGT.Offset(, 3)

targetCell = FinalPvtGT

End Sub

Are you expecting it after the last filled cell of the column R? If so, then replace the following line

Set targetCell = FinalPvtGT.Offset(, 3)

with

Set targetCell = Range("R" & sh.Rows.Count).End(xlUp).Offset(1, 0)

Answer 2

This is a code which maybe you can figure out to implement it to your code:

Sub test()

Set sht = Sheets("Sheet1")
Set pt1 = sht.PivotTables(1)
Set pt2 = sht.PivotTables(2)
Range("E26").Value = pt1.GetPivotData("SUM").Value
Range("B26").Value = pt2.GetPivotData("SUM").Value

End Sub

the grand total needs to be copied over to the next empty row in column R

Oops... sorry,
so your problem is the placement of the copied GrandTotal:).

I've found a code that can copy the grand total to a cell but I can't make it work to copy it in the next empty cell

Sheets("Sheet1").Cells(LastRow, 18).Select

If you step-run the code above, is the result of the active cell correct? Which as you expected that the result of the active cell is the next empty cell.

If it's not correct, then maybe you need to add .offset(1,0) before the .select . But still I don't know what is the value of your 'LastRow' variable. If the value is the last row number in the sheet (where mine is 1048576), then maybe you need to put .end(xlup).offset(1,0)

If it's correct, I wonder what is the problem?

It also can be done with the code above:

Sheets("Sheet1").Cells(LastRow, 18).value = pt1.GetPivotData("SUM").Value

The word "SUM" is depend on what is your pivot table GrandTotal column header name. Mine is SUM as seen in the image above.

This code is not depend on the row where the pivot table GrandTotal displayed. So you don't have to code to find the word for the pivot table GrandTotal first then offset(0,1) to get the value. If for example at first the GrandTotal display in row 200, and after data source change and refresh the GrandTotal display in row 1000, it will always give you the correct GrandTotal.

Answer 3

Pivot Grand Total to Specified Cell

Option Explicit

Sub PivotGrandTotal()

    Const SheetName As String = "Sheet1"
    Const writeColumn As Long = 18

    Dim rng As Range          ' PivotTable's RowRange, Last Non-Empty Cell
    Dim findString As String  ' PivotTable's GrandTotalName
    ' If certain that whole number, then use "As Long" in the following line.
    Dim gTotal As Double      ' Grand Total Value
    Dim FER As Long           ' Write Row (First Empty Row)

    With ThisWorkbook.Worksheets(SheetName)
        ' Retrieve Grand Total.
        With .PivotTables(1)
            findString = .GrandTotalName
            Set rng = .RowRange
        End With
        gTotal = rng.Find(findString, , xlFormulas).Offset(, 1).Value
        ' Define writeRow.
        Set rng = .Columns(writeColumn).Find("*", , xlFormulas, , , xlPrevious)
        If Not rng Is Nothing Then FER = rng.Row + 1 Else FER = 1
        ' Write to writeCell.
        .Cells(FER, writeColumn).Value = gTotal
    End With

End Sub