Help with VBA export of cells to PowerPoint

[JOTS]

Hi gurus,

I have simple problem that is apparently too tough for me to figure out
right now. I have a macro in Excel that loops, uses formulas to
populate cells in a range of cells to look like a chart, then opens
PowerPoint, copies the range, and then *is supposed to* paste the range
into a new slide and continue looping until the data is complete. I
have figured out how to do everything from opening Powerpoint, grabbing
the cells, and pasting them into a slide. I even figured out how to
create a new slide. The problem is for some reason, it always pastes
to the last slide in the presentation and just pastes the new graph
over the top of the old one. I know this is a simple matter of calling
out the correct active slide, but I am stumped. Any help? Here's some
code to chew on. There are three macros here to perform the function,
but I realize the problem lies in the last one "RangetoPresentation".

Sub OpenPP()
Dim objPPT As Object
Set objPPT = CreateObject("Powerpoint.application")
objPPT.Visible = True
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Set PPPres = objPPT.Presentations.Add
Set PPSlide = PPPres.Slides.Add(1, ppLayoutTitleOnly)
Application.Run "'Resume Tracker 2006.xls'!AAATest"
End Sub
----------------------------------------------------------------------------------------------
Sub AAATest()

Application.ScreenUpdating = True
Application.DisplayAlerts = False
On Error Resume Next

x = 1
Windows("Diverse Resume Tracker 2006.xls").Activate
Sheets("BGs").Select
Do While Cells(x, 1).Value <> ""
Worksheets("Template").Range("B1").Value = Worksheets("BGs").Cells(x,
1).Value
Application.Run "'Resume Tracker 2006.xls'!OffersDelivered"
Application.Run "'Resume Tracker 2006.xls'!RangeToPresentation"
x = x + 1
Sheets("BGs").Select
Loop

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub
--------------------------------------------------------------------------------------------

Sub RangeToPresentation()
' Set a VBE reference to Microsoft PowerPoint Object Library

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide

' Make sure a range is selected
If Not TypeName(Selection) = "Range" Then
MsgBox "Please select a worksheet range and try again.",
vbExclamation, _
"No Range Selected"
Else
' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
Set PPSlide = PPPres.Slides.Add(1, ppLayoutTitleOnly)
PPApp.ActiveWindow.ViewType = ppViewSlide

' Reference active slide
' **************I THINK THIS IS THE PROBLEM *****************
Set PPSlide =
PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)

' Copy the range as a picture
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlPicture

' Paste the range
PPSlide.Shapes.Paste.Select

' Align the pasted range
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End If

End Sub