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

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

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

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

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" 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

Sure...you can send me a file at

leaving out <removethis from the address.

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

Hutch

"jeannie v" wrote:

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" 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

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


"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

Hello,


I have the same issue as Jeannie V, I have a pivot table that I have to filter, for example sales for products A, B and C for the next three months 7, 8, 9


Tab "PV"

Week 7 *Values are not in their corresponding position, they are lightly moved to the left, total is marked with an x.

A B C TOTAL (x)
Product 1 100 200 300 X
Product 2 400 500 600 X
Product 3 700 800 900 X
Product 4 1000 1200 1400 X
Product 5 1600 1800 2000 X


Week 8 (only B & C products were sold)

B C TOTAL (x)
Product 1 200 300 X
Product 2 500 600 X
Product 3 800 900 X
Product 4 1200 1400 X
Product 5 1800 2000 X

Week 9 (again all products had good sales ; )

A B C TOTAL (x)
Product 1 100 200 300 X
Product 2 400 500 600 X
Product 3 700 800 900 X
Product 4 1000 1200 1400 X
Product 5 1600 1800 2000 X


And I have to paste those sales in another Tab named "Sales Results"

For example in that tab I have:

Current Week Results for: Week 9

A B C TOTAL (x)
Product 1 100 200 300 X
Product 2 400 500 600 X
Product 3 700 800 900 X
Product 4 1000 1200 1400 X
Product 5 1600 1800 2000 X


But every week they can change and the sales could be for one, two or the three products and the total will vary so I would have to create a macro that choose specifically for the label (A, B, C or the Total) and then specify in which row to paste it as a special value.

And also I have a transpose table like this one *The x is again lightly moved to the left but it means the total for each product


Product 1 Product 2 Product 3 Product 4 Product 5
TOTAL A X X X X X

Product 1 Product 2 Product 3 Product 4 Product 5
TOTAL B X X X X X

Product 1 Product 2 Product 3 Product 4 Product 5
TOTAL C X X X X X


And so on ...


I have one idea:

Sub Macro4_obtaindatafromapivottable_and_pasteitanothe rcell()

ActiveSheet.PivotTables("PivotTable2").PivotSelect "At Risk[All]", _
xlLabelOnly, True

Selection.Copy

'And to paste it in the new cell

Sheets("PV").Select

Range("H35").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'
End Sub


But the "At Risk[All]" copies me all the row before that declared value.



I hope my explanation was clear, please any help is considered.


Thank you guys,
Greetings

Hey Hutch,

I was stuck while coding for looping a drop-down and I came across your post (https://groups.google.com/forum/#!to...ns/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:=xlDa tabase, 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").PivotField s("Activity Descr")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable37").PivotField s("Name")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable37").PivotField s("Acc Date")
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable37").AddDataFie ld ActiveSheet.PivotTables( _
"PivotTable37").PivotFields("Hours"), "Sum of Hours", xlSum
ActiveSheet.PivotTables("PivotTable37").PivotField s("Activity Descr"). _
CurrentPage = "(All)"
With ActiveSheet.PivotTables("PivotTable37").PivotField s("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").PivotField s("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").PivotField s("Activity Descr"). _
CurrentPage = "(All)"
With ActiveSheet.PivotTables("PivotTable37").PivotField s("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").PivotField s("Activity Descr"). _
CurrentPage = "(All)"
With ActiveSheet.PivotTables("PivotTable37").PivotField s("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").PivotField s("Activity Descr"). _
CurrentPage = "(All)"
With ActiveSheet.PivotTables("PivotTable37").PivotField s("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").PivotField s("Activity Descr"). _
CurrentPage = "(All)"
With ActiveSheet.PivotTables("PivotTable37").PivotField s("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)