Sub launchpptandcopy()
Dim pptDoc As PowerPoint.Presentation
Dim pptApp As PowerPoint.Application
Dim Sld As Slide
Set Sld = ActiveWindow.View.Slide.SlideIndex
Set pptApp = New PowerPoint.Application
pptApp.Presentations.Open "C:\fichierSource.pptm"
With ActivePresentation
.Slides(1).Shapes.SelectAll.Copy
.Slides(Sld).Shapes.Paste
End With
End Sub