Tengo problemas para pegar valores de Excel en una tabla en ppt. Me da error en esta última línea, ¿alguien puede averiguar por qué y cómo se puede mejorar?

 Dim ppt As PowerPoint.Application Dim pres As PowerPoint.Presentation Dim sl As PowerPoint.Slide Dim sh As PowerPoint.Shape Dim sh1 As PowerPoint.Shape Dim r As Range Dim filterRange As Range Dim copyRange As Range Dim lastRow As Long Set ppt = New PowerPoint.Application Set pres = ppt.Presentations.Open(ThisWorkbook.Path & "\Edenred_ProjectStatus_Saxo.pptx") Set sl = pres.Slides(1) Set sh1 = sl.Shapes("Table 3") ThisWorkbook.Sheets("Action&Open_Point").Range("H1").AutoFilter field:=1, Criteria1:="Y" lastRow = ThisWorkbook.Sheets("Action&Open_Point").Range("D" & ThisWorkbook.Sheets("Action&Open_Point").Rows.Count).End(xlUp).Row Set copyRange = ThisWorkbook.Sheets("Action&Open_Point").Range("D2:D" & lastRow) ActiveWorkbook.Worksheets("Action&Open_Point").UsedRange.Font.Underline = False copyRange.SpecialCells(xlCellTypeVisible).Copy **sh1.TextFrame.TextRange.Paste**

Se ejecuta hasta "copiar", pero luego no lo pega en ppt. el error dice que está fuera de rango