Copy from Excel Worksheets to specific Powerpoint slides

Question

I am transferring data from excel to powerpoint slides with an automated script by using EXcel VBA. I'm trying to copy the usedrange of a excel worksheet and paste it to as a image in a powerpoint Template of 4th slide and from there on it should add new slides and copy the remaining worksheets to the next further slides. So, In my code for the first iteration it is copying from excel worksheet of first sheet and pasting it in the 4th slide but for the next iteration it is throwing the error as below:

The code which i'm currently using is getting the following error

"Run Time Error -2147188160(80048240) AutomationError".  

I'm new to Excel VBA. Please help Can anyone suggest me the code for the following.

Hope this is clearly explained. If not please ask for more clarification.

Thanks

Private Sub CommandButton2_Click()
  Dim PP As PowerPoint.Application
  Dim PPpres As Object
  Dim PPslide As Object
  Dim PpTextbox As PowerPoint.Shape
  Dim SlideTitle As String
  Dim SlideNum As Integer
  Dim WSrow As Long
  Dim Sh As Shape
  Dim Rng As Range
  Dim myshape As Object
  Dim myobject As Object 
  'Open PowerPoint and create new presentation
  Set PP = GetObject(class, "PowerPoint.Application")
  PP.Visible = True

  Set PPpres = PP.Presentations.Open("\\C:\Users\Templates")

 'Specify the chart to copy and copy it

  For Each WS In Worksheets
    If (WS.Name) <> "EOS" Then
        ThisWorkbook.Worksheets(WS.Name).Activate
        ThisWorkbook.ActiveSheet.UsedRange.CopyPicture
        lastrow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row   
 'Copy Range from Excel
  Set Rng = ThisWorkbook.ActiveSheet.Range("A1:I" & lastrow)
'Copy Excel Range
  Rng.Copy
For k = 4 To 40
    slidecount = PPpres.Slides.Count
    PP.ActiveWindow.View.GotoSlide (k)
'Paste to PowerPoint and position
    Set PPslide = PPpres.Slides(k)
    PPslide.Shapes.PasteSpecial DataType:=10  '2 = ppPasteEnhancedMetafile
    Set myshape = PPslide.Shapes(PPslide.Shapes.Count)
    'Set position:
      myshape.Left = 38
      myshape.Top = 152
'Add the title to the slide
    SlideTitle = "Out of Support, " & WS.Name & " "
    Set PpTextbox = PPslide.Shapes.AddTextbox(msoTextOrientationHorizontal, 
    0, 20, PPpres.PageSetup.SlideWidth, 60)
    PPslide.Shapes(1).TextFrame.TextRange = SlideTitle

  'Set PPslide = PPpres.Slides.Add(slidecount + 1, ppLayoutTitle)
   'Make PowerPoint Visible and Active
    PP.Visible = True
    PP.Activate
 'Clear The Clipboard
Application.CutCopyMode = False
Next k 
    Exit For   
  End If
    Next WS
End Sub