Looping failed (From Excel to Ppt)

[mmmarks]

Hi All,

I want to copy from Excel (Filtered Range) and paste in power point slide

Each copied Range in separate Slide . Like this I want to loop this action (Count is not fixed).

So far I've below code. which is not working as expected.

For Each Ccell In Worksheets("RAWDATA").Range("H2:H10")
    slidecount = myPresentation.slides.Count
    Set PPSlide = myPresentation.slides.Add(slidecount + 1, 12)
                   
   rcnt = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
   Set tbl = Worksheets("Sheet1").Range("A1:E" & rcnt)
 
   Worksheets("Sheet1").Activate
   Worksheets("Sheet1").Range("A1:E" & rcnt).AutoFilter
   tbl.AutoFilter 1, Criteria1:=Ccell
   
   tbl.SpecialCells(xlCellTypeVisible).Copy
  PPSlide.Shapes.PasteSpecial DataType:=2  '2 = ppPasteEnhancedMetafile
 
Next ccell

 

[mmmarks]

Can anyone help on above problem ?

 

[mmmarks]

Anybody knows how to do this ?

 

[Worf]

The following worked for me:

Sub XL_PPT()
Dim ccell As Range, objppt As Object, ppslide As Slide, tbl As Range, _
mypres As Presentation, ws As Worksheet
Set ws = Sheets("sheet1")
Set objppt = CreateObject("PowerPoint.Application")
objppt.Visible = True
objppt.Presentations.Open "c:\pub\2016\small1.pptx"
Set mypres = objppt.ActivePresentation
ws.Activate
Set tbl = ws.Range("A1:E" & ws.Range("A" & Rows.Count).End(xlUp).Row)
For Each ccell In Worksheets("RAWDATA").[H2:H4]
    Set ppslide = mypres.Slides.Add(mypres.Slides.Count + 1, 12)
    tbl.AutoFilter
    tbl.AutoFilter 1, Criteria1:=ccell
    tbl.SpecialCells(xlCellTypeVisible).Copy
    ppslide.Shapes.PasteSpecial DataType:=2
Next
End Sub