エクセルからグループ化した図形をパワーポイントに貼り付けたい

Question

エクセルで作成したグループ化させた図形(テキスト入力あり)を「元の書式を保持」したまま
パワーポイントのシートの位置や貼付大きさを指定した上で貼り付けがしたいです。

しかし実行すると以下のエラーメッセージが表示さえ、パワーポイントへの貼り付けが行えないです。
原因と対処方法を教えてほしいです。

発生している問題・エラーメッセージ

オブジェクトは、このプロパティまたはメソッドをサポートしていません。

該当のソースコード

Public Name As Object 'オブジェクト名
Public SldNmb As Integer 'スライド番号
Public Top As Integer '上からの位置
Public Left As Integer '左からの位置
Public Width As Integer '横幅
Public Odr As Integer '順番
 
Property Get Self() As Class1
  Set Self = Me '自己参照
End Property
 
Function CreateNew(NewName As Object, NewSldNmb As Integer, NewTop As Integer, _
                   NewLeft As Integer, NewWidth As Integer, NewOdr As Integer) As Class1
  With New Class1
    Set .Name = NewName 'オブジェクト名
    .SldNmb = NewSldNmb 'スライド番号
    .Top = NewTop '上からの位置
    .Left = NewLeft '左からの位置
    .Width = NewWidth '横幅
    .Odr = NewOdr '順番
    Set CreateNew = .Self '作成したインスタンスを返す
  End With
End Function

Sub オートシェイプ一斉貼り付け()
  'コレクション生成
  Dim Objs As Collection: Set Objs = New Collection
  
  'シート名を変数へセット
  Dim s1 As Worksheet: Set s1 = Sheets("シート１")
  Dim s2 As Worksheet: Set s1 = Sheets("シート２")
 
  '各要素をコレクションにセット
  'オブジェクト名, スライド番号, 上からの位置, 左からの位置, 横幅, 順番(0→最前面 1→最背面) の順で
  With New Class1
    Objs.Add .CreateNew(s1.Shapes.Range(Array("Group 1")), 2, 50, 10, 600, 0)  
    Objs.Add .CreateNew(s1.Shapes.Range(Array("Group 4")), 2, 50, 10, 600, 0)

    Objs.Add .CreateNew(s2.Shapes.Range(Array("Group 1")), 3, 50, 10, 600, 0)  
    Objs.Add .CreateNew(s2.Shapes.Range(Array("Group 4")), 3, 50, 10, 600, 0)
  End With
 
  'PPTの準備
  On Error GoTo ERROR_HANDLER
  Dim ppApp As Object: Set ppApp = CreateObject("PowerPoint.Application") 'PPTアプリ
  Dim pp As Object: Set pp = ppApp.ActivePresentation 'PPTプレゼン
  Dim ppSld As Object 'PPTスライド
  
  Dim Obj As Class1
  For Each Obj In Objs 'Objsコレクションをループ
    Obj.Name.CopyPicture xlScreen, xlPicture '指定オブジェクトをクリップボードにコピー
    Set ppSld = pp.Slides(Obj.SldNmb) 'PowerPointスライド指定
    ppSld.Shapes.Paste '貼り付け
 
    '位置・サイズを補正
    With ppSld.Shapes(ppSld.Shapes.Count) '最終シェイプを指定
      .LockAspectRatio = msoTrue '縦横比固定
      .Top = Obj.Top '上からの位置
      .Left = Obj.Left '左からの位置
      .Width = Obj.Width '横幅
      .ZOrder Obj.Odr '移動
    End With
  Next
 
TERMINATE:
  On Error GoTo 0
  Set ppApp = Nothing
  Set pp = Nothing
  Set ppSld = Nothing
  Exit Sub
 
ERROR_HANDLER:
  MsgBox Err.Description, vbCritical
  Resume TERMINATE
End Sub

補足事項

貼り付け先のパワーポイントは、指定されているスライドがすべて存在していて、既に開いているのが条件です。