Copying objects from powerpoint presentation to Excel, but not pasting in correct range

Question

So I have some VBA code that copies one objects from PowerPoint (in this case Text boxes) and pastes it into specific ranges in the workbook. Its 90% there but there is an issue when pasting multiple text boxes on one sheet. The code below pastes 10 different text boxes from 10 different slides. slides 4-7 are pasted on the same sheet, but 4 different ranges. However Slides 4-6 are pasted one on top of each other, only following the pasted range of the first one, but for some reason, slide 7's object is in the correct range.

To solve this I have tried to add waiting periods in between and I have also tried changing the order of the copying and pasting for all the slides, but nothing works. Can someone please help me with fixing this?

Dim Ppt As PowerPoint.Application

Sub Ppt_Extract_Shapes()
    'Add VBA References to PowerPoint 16.0 Type Library '''

    Set Ppt = VBA.CreateObject("PowerPoint.application")

    Dim filePath As String
    filePath = "put_your_file_name_here"

    With Ppt
        .Visible = msoTrue
        .Presentations.Open (filePath)

            paste_from_slide 3, "Summary", "M12"
            paste_from_slide 4, "Summary2", "F24"
            paste_from_slide 5, "Summary2", "F40"
            paste_from_slide 6, "Summary2", "F65"
            paste_from_slide 7, "Summary2", "F91"
            paste_from_slide 8, "Wages", "M11"
            paste_from_slide 9, "Supplies", "L9"
            paste_from_slide 10, "Ancillary", "M11"
            paste_from_slide 11, "Fixed", "AB4"
            paste_from_slide 11, "Debt", "S28"

        .Quit
    End With

End Sub

Function paste_from_slide(slideIndex As Integer, targetWsName As String, _
                          destinationRng As String, _
                          Optional shapeName As String = "Content Placeholder 1")

    Dim pptShape As PowerPoint.Shape
    Dim pptSlide As PowerPoint.Slide
    Dim exlShape As Excel.Shape

    Dim Ws As Excel.Worksheet
    Dim Rng As Excel.Range

    Set Ws = Excel.ThisWorkbook.Worksheets(targetWsName)
    Set Rng = Ws.Range(destinationRng)

    Set pptSlide = Ppt.ActivePresentation.Slides(slideIndex)
    Set pptShape = pptSlide.Shapes(shapeName)
        pptShape.Copy
        Ws.Paste
    Set exlShape = Ws.Shapes(shapeName)
        exlShape.Left = Rng.Left
        exlShape.Top = Rng.Top

End Function

Answer 1

This may be your problem:

 Set exlShape = Ws.Shapes(shapeName)

There's no guarantee the names of shapes in Excel are unique.

If you want the last pasted shape then this is pretty reliable:

 Set exlShape = Ws.Shapes(Ws.Shapes.Count)