Sélection de plusieurs lignes séparées VBA

Bonjour à tous,

Je suis nouveau sur ce forum, si jamais je fais des boulettes, restez indulgents ^^

J'ai beaucoup cherché mais je n'arrive pas à avoir la solution.

J'ai un code VBA qui m'ouvre un PowerPoint et dans ce PowerPoint, Excel copie des partie de tableau.

Le problème, c'est que je souhaite copier des bouts de tableau dans des slides différentes mais avec toujours mes lignes d'en-tête.

J'ai tester beaucoup de choses mais le code ci-dessous me copie l'en-tête mais aussi toutes les lignes entre l'en-tête et la plage nommé plage1.

Exemple : ici mon en-tête sont les lignes 5 et 6 et la plage 1 correspond aux lignes 9 à 15.

Et bien Excel me copie les lignes 5 à 15 dans ma slide... Alors que je souhaite les lignes 5, 6 et direct en dessous 9 à 15.

Private Sub CommandButton1_Click()
Dim PPTApp As PowerPoint.Application
Dim PPTDoc As PowerPoint.Presentation
Dim Chemin As String

    Chemin = ThisWorkbook.Path
    Set PPTApp = CreateObject("PowerPoint.application")
    PPTApp.Visible = True
    Set PPTDoc = PPTApp.Presentations.Add
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

Dim plage As Variant

plage1 = TextBox1.Value

Range("5:6" & "," & plage1).Select
Selection.Copy
PPTDoc.Slides.Add Index:=1, Layout:=ppLayoutBlank
PPTDoc.Slides(1).Shapes.Paste
Application.CutCopyMode = False

J'espère avoir été clair.

Merci d'avance

bonjour,

la copie de plages non contigues semblent ne pas fonctionner entre excel et powerpoint, passe par une feuille intermédiaire dans laquelle tu construis le tableau avec les lignes que tu souhaites copier dans ton ppt.

Sub test()

    Dim PPTApp As PowerPoint.Application
    Dim PPTDoc As PowerPoint.Presentation
    Dim wss, ws
    Dim Chemin As String

    Chemin = ThisWorkbook.Path
    Set PPTApp = CreateObject("PowerPoint.application")
    PPTApp.Visible = True
    Set PPTDoc = PPTApp.Presentations.Add
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim plage1 As Variant
    Set wss = ActiveSheet
    plage1 = TextBox1.Value
    Set ws = Sheets.Add
    wss.Range("A1:D1" & "," & plage1).Copy ws.Cells(1, 1)
    ws.UsedRange.Copy
    PPTDoc.Slides.Add 1, ppLayoutBlank
    PPTDoc.Slides(1).Shapes.Paste
    Application.CutCopyMode = False
    ws.Delete
End Sub

Un grand merci à toi h2so4

C'est parfait je n'avais pas pensé à fonctionner ainsi.