copy pivot table

[shadow12345]

Hi,
I am looking for a way to copy a pivot table named "PivotTable6" (could appear on any sheet name in the workbook) to the same sheet as the one containing a pivot table named "PivotTable5" (also could be on any sheet)

I would like to put 6 under five leaving 2 blank rows in between

Any thoughts ?

 

[gingerafro]

I can give you the logic behind how to tackle this problem, but my VBA is a bit pidgeon.

You will need to find these pivots first, by using a loop through each worksheet. However, if the macro doesn't find the pivot, then it will error, so you will need to put in a break. Something like 'On Error resume next' might work.

Once you've found the pivots, I'd use the macro recorder to ge the syntax of how to place it somewhere else.

Hope thats a start

 

[shadow12345]

no idea how to find the pivot tables within the worksheets thought

 

[gingerafro]

This is how I would start trying to find the pivot table. This doesn't currently work, and hopefully simeone might be able to fix it.

Sub findpivot()

Dim i As Worksheet
Dim wb1 As Workbook

For Each i In wb1
On Error Resume Next
If ActiveSheet.PivotTables("pivottable3").Visible = True Then
truesheet = ActiveSheet
End If

MsgBox (truesheet)
Next i

End Sub

I did say that my VBA was pidgeon!!

 

[shadow12345]

it better than mine, no idea how to do it

 

[oliver_penney]

hi guys

how about this:-

Option Explicit

Function FindPivot(PivotName As String) As String
Dim LoopWorkSheet As Worksheet, LoopPivot As Object

FindPivot = "#N/A"

For Each LoopWorkSheet In ActiveWorkbook.Worksheets
For Each LoopPivot In LoopWorkSheet.PivotTables
If LoopPivot.Name = PivotName Then
FindPivot = LoopWorkSheet.Name
End If
Next
Next

End Function

Sub CopyPivotOver()
Dim fromWB As String, toWB As String, TargetRow As Integer

fromWB = FindPivot("PivotTable6")
toWB = FindPivot("PivotTable5")

Sheets(fromWB).Activate
Sheets(fromWB).PivotTables("PivotTable6").PivotSelect "", xlDataAndLabel, True
Selection.Copy

TargetRow = Sheets(toWB).Range("a1").SpecialCells(xlLastCell).Row + 5

Sheets(toWB).Activate
Range("a" & TargetRow).Select
ActiveSheet.Paste
End Sub

i guessed with the targetrow thing...

 

[oliver_penney]

and ginge:-

your way would work...

if you're gonna do a For Each... Next statement, it needs to work on a collection, eg. ActiveWorkbook.Worksheets and if you declared truesheet as a string and then used truesheet=activesheet.name if would nearly be there, but not quite there cos the activesheet wont actually change, it's "i" that is changing in the loop

it takes a while to able to write it from scratch but it'll get there

hope that helps

merry xmas

 

[shadow12345]

excellent that works. Thanks a lot and Merry xmas to you to.

 

[gingerafro]

Thanks for the help as well Oliver.
I'm always willing to learn from those willing to teach!
ta