请尝试下一种方法：

Sub testCopyShape()
 Dim ws_d As Worksheet, ExcelSheet As Workbook
 
   'set the above objects as you need__________________________
   '...
   Set ws_d = ActiveSheet 'use here what you need
   Set ExcelSheet = Workbooks("workbook name") 'use here its REAL NAME
   '___________________________________________________________
   
   ws_d.Shapes(1).Copy

   ExcelSheet.Worksheets(1).Paste 'to paste in the workbook first sheet
   'move the shape where you need:
   With ExcelSheet.Worksheets(1).Shapes(ExcelSheet.Worksheets(1).Shapes.Count)
        .Left = ExcelSheet.Worksheets(1).Range("B3").Left
        .Top = ExcelSheet.Worksheets(1).Range("B3").Top
    End With
End Sub

这种方式不需要选择/激活任何东西。否则，您可以激活所需的工作表（Worksheets(1)），选择要粘贴的区域，然后使用Worksheets().Paste，将形状放置在之前选定的单元格中。