View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.worksheet.functions
jeannie v jeannie v is offline
external usenet poster
 
Posts: 127
Default Macro to Copy Pivot Table Data to Another Worksheet in Same Wo

H Tom:

I'm on conference calls most of the day....but, I will work on this tonight
and let you know how I make out.....Thank you so much...I wasn't sure this
could be done, so I'm really excited to work it out....
--
jeannie v


"Tom Hutchins" wrote:

Oops...

Call ShowItem("Product",
should be
Call ShowItem("Location",

Hutch

"Tom Hutchins" wrote:

I'm not sure if you are creating the other 32 sheets from nothing each time
you copy & paste the pivot data, or if you want to paste the data in a
certain place on each sheet, add to the previous data on the sheets, etc.

The following code should display each location in turn (hiding all the
others), and copy the first 10 rows to a new sheet. The new sheet is named
for that location. My sample pivot table has two rows of headings (most do),
and begins in cell A6. You may have to adjust the range of rows in the
Copy10Rows subroutine to match your pivot table. Also, I am copying whole
rows to the new sheets, because that was the easiest option. I don't expect
this code is exactly what you need, but it's a starting point. Let me know
how it works and what you would like it to do differently.

Option Explicit

Public Sub CopyLocation()
Dim x As Long
With ActiveSheet.PivotTables(1)
For x = 1 To .PivotFields("Location").PivotItems.Count
Call ShowItem("Product", .PivotFields("Location").PivotItems(x))
Call Copy10Rows
Next x
End With
End Sub

Private Function ShowItem(WhichFld As String, SelItem As String) As Boolean
'Declare local variables
Dim ItemFound As Boolean, x As Long, pvtItm
ItemFound = False
'Make the first pivotitem visible
Set pvtItm = ActiveSheet. _
PivotTables("PivotTable1"). _
PivotFields(WhichFld$).PivotItems(1)
pvtItm.Visible = True
'Hide every item in the pivottable that does not
'match SelItem$.
For x& = 2 To ActiveSheet. _
PivotTables("PivotTable1"). _
PivotFields(WhichFld$).PivotItems.Count
Set pvtItm = ActiveSheet. _
PivotTables("PivotTable1"). _
PivotFields(WhichFld$).PivotItems(x&)
If pvtItm = SelItem$ Then
pvtItm.Visible = True
ItemFound = True
Else
pvtItm.Visible = False
End If
Next x&
'Unless the first PivotItem matches SelItem$, hide it.
Set pvtItm = ActiveSheet. _
PivotTables("PivotTable1"). _
PivotFields(WhichFld$).PivotItems(1)
If pvtItm < SelItem$ Then
If ItemFound = True Then
pvtItm.Visible = False
End If
Else
ItemFound = True
End If
'If no item in the pivottable matches SelItem$,
'display an error message and quit.
If ItemFound = False Then
MsgBox SelItem$ & " not found in pivot table"
ShowItem = False
Exit Function
End If
'Free object variables
Set pvtItm = Nothing
ShowItem = True
Exit Function
SIerr:
ShowItem = False
End Function

Private Sub Copy10Rows()
'Copies 10 rows of data + 1heading row from pivot table
'to a new sheet.
Dim NewSht As Worksheet, StartSht As Worksheet
On Error GoTo C10Rerr
Set StartSht = ActiveSheet
Sheets.Add
Set NewSht = ActiveSheet
StartSht.Select
'Assumes pivot table has two rows of headings (6 & 7). If we
'include row 6 in the Copy & Paste, the whole pivot table gets
'copied. Including row 7 + 10 more rows works.
Rows("7:17").Select
Selection.Copy
NewSht.Select
ActiveSheet.Paste
NewSht.Select
'Name the sheet for the value in the column A field.
NewSht.Name = NewSht.Range("A2").Value
StartSht.Select
Cleanup:
Set StartSht = Nothing
Set NewSht = Nothing
Exit Sub
C10Rerr:
MsgBox "Could not copy data", , "Copy10Rows"
GoTo Cleanup
End Sub

Hope this helps,

Hutch

"jeannie v" wrote:

Hi Again Experts:

I have a project with tremendous impact if I can determine if it is possible
to copy the first 10 lines of the data in a Pivot Table from the
DropDown...Let me explain...

I run a Pivot Table for 32 Locations...I need to select each location
separately from the DropDown in the Pivot Table and copy the first 10 lines
for that location to another separate worksheet which exclusive to that
location...in other words, I have 32 separate worksheets besides the Raw Date
worksheet and the Pivot Table...I do it manually now, but would like to do it
with a Macro if it is at all possible.

Is this possible?

Any help you can provide would be greatly appreciated!

--
jeannie v