Macro to Copy Pivot Table Data to Another Worksheet in Same Workbo

[jeannie v]

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

[Tom Hutchins]

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

[Tom Hutchins]

Oops...

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

Hutch

[jeannie v]

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

[jeannie v]

Hi Tom:

I am so sorry to say that I am lost....Your expertise is awesome and I tried
to follow the Macro the best I could, but I'm afraid it is beyond my current
understanding...Would I be able to send you a Dummy of the way my report is
setup and maybe you could walk me through the Macro to make it work?

I would appreciate any help you can provide...This Macro would be a HUGE
help in reducing the amount of time I spend on it every day.

Thank you for your consideration,
--
jeannie v

[Tom Hutchins]

Sure...you can send me a file at
hutch99999<removethis>@yahoo.com
leaving out <removethis> from the address.

I'll keep checking my email and watching this thread.

[jeannie v]

Hi Tom:

I cannot thank you enough for your help with this Macro...It works perfectly
and save me so much time in processing my report.

You are awesome!!!!!
--
jeannie v

[siddha...@gmail.com]

Hey Hutch,

I was stuck while coding for looping a drop-down and I came across your post (https://groups.google.com/forum/#!topic/microsoft.public.excel.worksheet.functions/KCIQJzf0GeE) .
I was wondering if you could help me with a similar problem. I'm pretty new to excel and macro coding and I'd really appreciate it if you can help me out.

I need to create a macro while enables the user to do the following :

1. Browse for a file
2. Create a pivot table once the file is inserted.
3. From the drop down list that is generated in the pivot table, all the data from each item in the drop-down should be copied into a new sheet in the same workbook.
4. Each time I browse a file, the items in the drop down list might not be the same after the pivot is created. (Generalized)

The following is the code that I developed. I'd be really grateful if you can help me out with this :) .

Sub Macro4()
'
' Macro4 Macro
'

'
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:R6521C12", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="Sheet4!R3C1", TableName:="PivotTable37", DefaultVersion _
:=xlPivotTableVersion14
Sheets("Sheet4").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable37").PivotFields("Activity Descr")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable37").PivotFields("Name")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable37").PivotFields("Acc Date")
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable37").AddDataField ActiveSheet.PivotTables( _
"PivotTable37").PivotFields("Hours"), "Sum of Hours", xlSum
ActiveSheet.PivotTables("PivotTable37").PivotFields("Activity Descr"). _
CurrentPage = "(All)"
With ActiveSheet.PivotTables("PivotTable37").PivotFields("Activity Descr")
.PivotItems("General").Visible = False
.PivotItems("Meetings/ Calls/ Proposals").Visible = False
.PivotItems("Scheduled But not Utilized").Visible = False
.PivotItems("Training").Visible = False
End With
ActiveSheet.PivotTables("PivotTable37").PivotFields("Activity Descr"). _
EnableMultiplePageItems = True
Cells.Select
Selection.Copy
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "Client Work"
Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet4").Select
ActiveSheet.PivotTables("PivotTable37").PivotFields("Activity Descr"). _
CurrentPage = "(All)"
With ActiveSheet.PivotTables("PivotTable37").PivotFields("Activity Descr")
.PivotItems("ClientWork").Visible = False
.PivotItems("Meetings/ Calls/ Proposals").Visible = False
.PivotItems("Scheduled But not Utilized").Visible = False
.PivotItems("Training").Visible = False
.PivotItems("General").Visible = True
End With
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "General"
Sheets("Sheet4").Select
ActiveSheet.PivotTables("PivotTable37").PivotFields("Activity Descr"). _
CurrentPage = "(All)"
With ActiveSheet.PivotTables("PivotTable37").PivotFields("Activity Descr")
.PivotItems("General").Visible = False
.PivotItems("Meetings/ Calls/ Proposals").Visible = True
End With
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Sheet5").Select
Sheets("Sheet5").Name = "Meeting Calls Proposals"
Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet4").Select
ActiveSheet.PivotTables("PivotTable37").PivotFields("Activity Descr"). _
CurrentPage = "(All)"
With ActiveSheet.PivotTables("PivotTable37").PivotFields("Activity Descr")
.PivotItems("Meetings/ Calls/ Proposals").Visible = False
.PivotItems("Scheduled But not Utilized").Visible = True
End With
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Sheet6").Select
Sheets("Sheet6").Name = "Scheduled but not utilized"
Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet4").Select
ActiveSheet.PivotTables("PivotTable37").PivotFields("Activity Descr"). _
CurrentPage = "(All)"
With ActiveSheet.PivotTables("PivotTable37").PivotFields("Activity Descr")
.PivotItems("Scheduled But not Utilized").Visible = False
.PivotItems("Training").Visible = True
End With
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Sheet7").Select
Sheets("Sheet7").Name = "Training"
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("Scheduled but not utilized").Select
Range("A1").Select
Sheets("Meeting Calls Proposals").Select
Range("A1").Select
Sheets("General").Select
Range("A1").Select
Sheets("Client Work").Select
Range("A1").Select
Sheets("Sheet1").Select
Range("A1").Select
Sheets("Sheet4").Select
Range("A1").Select
End Sub





This is a specific macro . I'm looking for something that will work for any xlsx file (all with same column headers)