Pasting Excel Range Into Powerpoint Notes section - excel

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