How to use DataBodyRange property to write to a specific sheet?

Hi,

I am new to VBA programming. I got this code snippet and it reads a pivot table and it CREATES A NEW WORKSHEET in the workbook and then writes the content to it. I want to know how I can modify this code to write to a specific sheet in the same workbook. Like for example, I want the contents to write to a specific sheet "Results_Obtained" in the same workbook. Is there any option ? Here is the code snippet.

Code:

---


For Each pvt In ActiveSheet.PivotTables
    With pvt
        .ColumnGrand = True
        .RowGrand = True
    End With
    Set rng = pvt.DataBodyRange
    rng.Cells(rng.Rows.Count, rng.Columns.Count).ShowDetail = True
Next pvt

---

My Pivot Table looks like the one I have put in the attachment (vbacodehelp.xls). It is in the sheet PivotTable.




From the code snippet I have provided above, the output I get perfectly is as shown in the attachement (Sheet from code snippet).

The only problem is, the code writes to a new sheet, rather than a sheet which I want to. Can someone help. Thanks

Edit: Vba tags added to code. Select your code when posting and hit the vba button to format it for the forum.

You did not include the code that does the actual copying.

Hmm,

The code snippet I have put did not have any code for copying. When I ran the program, these codes put the entire content to a new sheet. I only want the code to write to a sheet in the same workbook, say like "Results_Obtained". Thanks

I got the following code snippet from another site. I just copied it and put it for my use. It gave me the output that I have put in the excel sheet.

Code:

---

Sub Extract_Data_From_Pivot()
    For Each pvt In ActiveSheet.PivotTables
        With pvt
            .ColumnGrand = True
            .RowGrand = True
        End With
        Set rng = pvt.DataBodyRange
        rng.Cells(rng.Rows.Count, rng.Columns.Count).ShowDetail = True
    Next pvt
End Sub

---

Code:

---

Sub CopyPivot()
    Dim pvt As PivotTable
    Dim rng As Range
    For Each pvt In ActiveSheet.PivotTables
        With pvt
            .ColumnGrand = True
            .RowGrand = True
        End With
        Set rng = pvt.DataBodyRange
        rng.Cells(rng.Rows.Count, rng.Columns.Count).ShowDetail = True
        Selection.Copy Worksheets("Sheet3").Range("A1")
        Application.DisplayAlerts = False
        ActiveSheet.Delete
        Application.DisplayAlerts = True
    Next pvt
End Sub

---

Hi James,

Bulls eye. It worked. This was what I had wanted.

I did try doing a copy from the following lines of code, but did not get the required output.

Code:

---

rng.Copy Worksheets("Result").Range("A1")

---

It had copied the entire range. Now I understand from your code that you have specifically given the line as

Code:

---

Selection.Copy Worksheets("Sheet3").Range("A1")

---