Excel to PPT VBA Positioning - Despite other answers... no success Please help

[certainlyfrustrated]

Hi there,

I have combed many of the answers that beat around this, even on other forums, but none seem to work for me. I am very much a novice or less with VBA and trying to make this work as saves an enormous amount of time. My issue is that the slides have varying positions and even that aside, I still haven't been able to get the slide to properly position the charts:

Sheet 13 needs special position of 1.14 x 1.4
All other Slide Position 0.92 x 1.32
GraphSize 5.26, 8.6 with position 3.82 and 1.36

My current VBA code is below but does not yet even touch upon the sizing for the Graphs or Sheet 13. Any help here is VERY much appreciated as I have been touching on this on and off for years with no success and been manually moving... Code is below. Thank you so much for the help if any!

Sub PasteMultipleSlides()

'PURPOSE: Data Transfer from Excel to PPT

Dim myPresentation As Object
Dim mySlide As Object
Dim PowerPointApp As Object
Dim shp As Object
Dim MySlideArray As Variant
Dim MyRangeArray As Variant
Dim x As Long
Dim PPApp  As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide

'Create an Instance of PowerPoint
  On Error Resume Next
    
    'Is PowerPoint already opened?
      Set PowerPointApp = GetObject(class:="PowerPoint.Application")
    
    'Clear the error between errors
      Err.Clear

    'If PowerPoint is not already open then Exit
      If PowerPointApp Is Nothing Then
        MsgBox "PowerPoint Presentation is not open, aborting."
        Exit Sub
      End If
    
    'Handle if the PowerPoint Application is not found
      If Err.Number = 429 Then
        MsgBox "PowerPoint could not be found, aborting."
        Exit Sub
      End If

  On Error GoTo 0
  
'Make PowerPoint Visible and Active
  PowerPointApp.ActiveWindow.Panes(2).Activate
    
'Create a New Presentation
  Set myPresentation = PowerPointApp.ActivePresentation

'List of PPT Slides to Paste to 
  MySlideArray = Array(9, 10, 11, 12, 13, 5, 14, 15, 8, 7, 8, 22, 22, 22, 18, 16, 16, 17, 17, 1)

'List of Excel Ranges to Copy from
  MyRangeArray = Array(Sheet1.Range("A1:B9"), Sheet2.Range("A1:B7"), Sheet3.Range("A1:B7"), _
       Sheet4.Range("A1:B8"), Sheet5.Range("A1:B10"), Sheet7.Range("A1:B8"), Sheet6.Range("A1:B8"), _
       Sheet8.Range("A1:C8"), Sheet1.Range("B8"), Sheet7.Range("B3"), Sheet7.Range("A1:B7"), _
       Sheet9.Range("AA3"), Sheet9.Range("Z4"), Sheet9.Range("Z13"), Sheet13.Range("A1:K20"), _
       Sheet9.Range("Z4"), Sheet9.Range("AA4"), Sheet9.Range("Z13"), Sheet9.Range("AA16"), Sheet13.Range("A27"))
    
'Loop through Array data
  For x = LBound(MySlideArray) To UBound(MySlideArray)
  
    'Copy Excel Range
        MyRangeArray(x).Copy
    
    'Paste to PowerPoint and position
      On Error Resume Next
        Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=10)
   shp.Left = 1.36 * 72
    shp.Top = 0.92 * 72
      On Error GoTo 0

      
  Next x
  
        ' Reference existing instance of PowerPoint
        Set PPApp = GetObject(, "Powerpoint.Application")
        ' Reference active presentation
        Set PPPres = PPApp.ActivePresentation
  
'Copy "Chart 10" to Slide # 16 
        ' Copy "Chart 10"
            Sheets("Chart 1 OS").Select
    ActiveChart.ChartArea.Select
    ActiveChart.ChartArea.Copy
        ' Paste chart  to Slide # 16
        With PPPres.Slides(16).Shapes.Paste
            ' Align pasted chart
            .Align msoAlignCenters, True
            .Align msoAlignMiddles, True
        End With
        
'Copy "Chart 11" to Slide # 17
        ' Copy "Chart 11"
            Sheets("Chart 2 SH").Select
    ActiveChart.ChartArea.Select
    ActiveChart.ChartArea.Copy
        ' Paste chart  to Slide # 17
        With PPPres.Slides(17).Shapes.Paste
            ' Align pasted chart
            .Align msoAlignCenters, True
            .Align msoAlignMiddles, True
        End With
        

'Transfer Complete 
  Application.CutCopyMode = False
  ThisWorkbook.Activate
  MsgBox "Complete!"

End Sub