Sub PPT()
Dim c As Range, texte$, PPApp
For Each c In [Tableau1].Columns(2).Cells
If c <> "" Then texte = texte & vbLf & c
Next
texte = Mid(texte, 2)
Set PPApp = CreateObject("PowerPoint.Application")
PPApp.Visible = True
PPApp.Presentations.Open ThisWorkbook.Path & "\PrésentationPPT.pptx"
PPApp.ActivePresentation.Slides(1).Shapes("espaceCom").TextFrame2.TextRange = texte
AppActivate PPApp.Caption 'active PP
End Sub