I'm having trouble pasting values from excel into a table in ppt. It gives me error in this last line, can anybody figure out why and how it can be improved?

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**

It runs until "copy" but then it does not paste it on ppt. the error says it is out of range