How to use VBA to paste from Excel in to Power Point as an embedded table

Hi,

I am using the code below and it works fine to paste as a picture. It took me a lot of hunting and pecking on the internet to put this code together. I was just asked to have it paste as an embedded table. I am not sure how to do this in VBA. I am grateful for any help anyone can provide?

This is pulling each row of of 250+ lines of a worksheet, along with the header row.

You'll notice I 'deactivated' quite a few lines of code using " ' " but I left them in the module.

Sub CopyRangeToPresentation()

'Slides for

'Variables

Dim PP As PowerPoint.Application

Dim PPpres As PowerPoint.Presentation

Dim PPslide As PowerPoint.Slide

Dim SlideTitle As String

Dim lRow As Long

Dim i As Integer

'Fider

lRow = Cells.Find(What:="*", _

                After:=Range("A1"), \_ 

                LookAt:=xlPart, \_ 

                LookIn:=xlFormulas, \_ 

                SearchOrder:=xlByRows, \_ 

                searchdirection:=xlPrevious, \_ 

                MatchCase:=False).row 

'New presentation

Set PP = New PowerPoint.Application

Set PPpres = PP.Presentations.Add

Set PP = GetObject(, "PowerPoint.Application")

PP.Visible = 1

For i = 1 To lRow

'New slide

  Set PPslide = PPpres.Slides.Add(i, ppLayoutBlank) 

  PP.ActiveWindow.ViewType = ppViewSlide 

  PPpres.PageSetup.SlideSize = ppSlideSizeOnScreen 

  PP.ActiveWindow.WindowState = ppWindowMaximized 

  PPslide.Select 

'Copy

  Sheets("Sheet1").Range("A1:K1").CopyPicture \_ 

  'Range("A1").Copy 

  'PPslide.Shapes.Paste 

  'PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True 

  'PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True 

  With PPslide.Shapes.Paste(1) 

.Left = 0

.Top = 2.55 * 72 ' 72 points=1in

.Height = 72 * 3.39

    .Width = 72 \* 9.8 

    PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True 

End With

Application.CutCopyMode = False

  Sheets("Sheet1").Range(Cells(i, 1), Cells(i, 11)).CopyPicture \_ 

  Appearance:=xlScreen, Format:=xlPicture 

'Paste

 ' PPslide.Shapes.Paste.Select 

 ' PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True 

 ' PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True 

       With PPslide.Shapes.Paste(1) 

.Left = 0

.Top = 2.92 * 72 ' 72 points=1in

.Height = 72 * 3.39

    .Width = 72 \* 9.8 

    PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True 

End With

'Title

Next i

'Memory

  PP.Activate 

  Set PPslide = Nothing 

  Set PPpres = Nothing 

  Set PP = Nothing 

End Sub