Pasting Excel Range Into Powerpoint Notes section

Question

So I am trying to paste a column into powerpoint slide notes but it only grabs one cell and pastes it into the first slide and will not go to the next slide and paste the next cell into the notes of the 2nd slide.

Sub Notes() 


    Dim PPTApp As PowerPoint.Application 
    Dim PPTPres As PowerPoint.Presentation 
    Dim PPTSlide As PowerPoint.Slide 
    Dim PPTShape As PowerPoint.Shape 
    Dim strNotes As String 
     ' Amended Dim Sh As Shape to...
    Dim Sh As PowerPoint.Shape 


     'launch powerpoint application
    Set PPTApp = New PowerPoint.Application 
    PPTApp.Activate 
     'open powerpoint presentation for macmahon off the intranet
    Set PPTPres = PPTApp.Presentations.Open("C:\Users)


    Sheets("Raw Data").Select 
    Range("M2:M26").Select 


    Set PPTSlide = PPTPres.Slides(1) 


    On Error GoTo errHandler 




    Do While ActiveCell.Value <> "" 
        ActiveCell.Copy 
        With PPTSlide 
            If PPTSlide.NotesPage.Shapes.Count = 0 Then 'If no shapes to take Notes then add a shape first
                PPTSlide.NotesPage.Shapes.AddShape msoShapeRectangle, 0, 0, 0, 0 
                Sh = PPTSlide.NotesPage.Shapes(1) 
                 'Code change here - did not recognize Sh.TextFrame.TextRange.Text.Paste
                 'So, I set the object text to value of the active cell and seemed to do the trick


                Sh.TextFrame.TextRange.Text = ActiveCell.Value 
            Else 'has shapes, so see if they take text
                For Each Sh In PPTSlide.NotesPage.Shapes 
                    If Sh.HasTextFrame Then 
                         'Code change here - did not recognize Sh.TextFrame.TextRange.Text.Paste
                         'So, I set the object text to value of the active cell and seemed to do the trick
                        Sh.TextFrame.TextRange.Text = ActiveCell.Value 
                    End If 
                Next Sh 
            End If 
        End With 
        Set PPTSlide = PPTPres.Slides.Add(PPTPres.Slides.Count + 1, ppLayoutText) 
        ActiveCell.Offset(1, 0).Select 
    Loop 
    Exit Sub 
errHandler: 
    MsgBox Err.Number & vbTab & Err.Description, vbCritical, "Error" 
End Sub

Answer 1

You are setting a fixed reference to slide 1 in this line:

Set PPTSlide = PPTPres.Slides(1)

Instead of that, wrap the code to copy and paste the cell content in a For...Next loop which loops through your desired slides. For example, to loop through all slides in the presentation:

For Each PPTSlide In PPTPres.Slides
  With PPTSlide
    ' Do the things you need to do on this slide
  End With
Next

Or manage a pre-defined range of slides:

Dim lSlideIndex As Long
For lSlideIndex = 2 to 5 ' Process slides 2 to 5
  With PPTPres.Slides(lSlideIndex)
    ' Do the things you need to do on this slide
  End With
Next