Select certain data from a Pivot and copy this into Powerpoint

[perry_boor]

Hi,

I've got a problem with selecting certain data from a Pivot table and
to copy this data into Powerpoint.

The macro has to select the following data from the Pivot:
Column 1: ABX
Column 2: wk01-2006

I'm currently using these lines, but the problem is that the macro also
selects other data from the pivot which i don't need. The only other
option I've got is to give in some lines which switch of all other data
in the pivot. Unfortunately i've got a lot of colums so this will cost
me a lot of time.

Does anybody knows a shorter way to do this?

Greetz Perry

Dim objPrs As Object
Dim objGraph As Object
Dim objDataSheet As Object
Dim rngData As Range
Dim intRow As Integer
Dim intCol As Integer
Dim PPSlide As PowerPoint.Slide
Dim PPPres As PowerPoint.Presentation
Dim PPApp As PowerPoint.Application
Dim PresentationFileName As Variant
Dim SlideCount As Long
Dim iCht As Integer

' open powerpoint
' Set objPPT = CreateObject("Powerpoint.application")
Set PPApp = CreateObject("Powerpoint.application")
PPApp.Visible = True
PPApp.Presentations.Open ThisWorkbook.Path & "\Template.ppt"
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide

SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides(3)
PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex

Windows("Exception Overview KPI Reporters.xls").Activate
Sheets("Pivot PU").Select
ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Carrier")
.PivotItems("ABX").Visible = True
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Week")
.PivotItems("wk01-2006").Visible = True
End With

ActiveSheet.Range("J4").Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Range(Selection, Selection.End(xlToLeft)).Select
Selection.CopyPicture xlScreen, xlPicture

With PPSlide
' paste and select the chart picture
.Shapes.Paste.Select
' align the chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters,
True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles,
True
End With
' Next

 

[Tom Ogilvy]

If you use code like this:

ActiveSheet.Range("J4").Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Range(Selection, Selection.End(xlToLeft)).Select
Selection.CopyPicture xlScreen, xlPicture


your pretty much stuck with what it picks up. If you know more about the
structure of the data, then perhaps you can use a smarter algorithm to get
the area you want.