VBA Excel：跨表复制对象至最后激活工作表报错求助

错误原因 #

1. 变量类型声明错误：原代码中Dim MooSheet, CurrentSheet As Worksheet仅将CurrentSheet声明为Worksheet类型，MooSheet实际是Variant类型，会导致后续Shape操作的类型不兼容。
2. 依赖Select/Selection的不稳定操作：在多工作表场景下，切换工作表时的激活状态可能意外改变，导致Selection指向错误对象。
3. Paste方法使用错误：复制Shape对象后，不能直接调用单元格区域的Paste方法，该方法不支持Shape类型的粘贴。

修正后的可行代码 #

Sub AddCabinet()
    ' 正确声明两个工作表变量
    Dim MooSheet As Worksheet, CurrentSheet As Worksheet
    ' 先记录当前激活的工作表（点击按钮时的工作表）
    Set CurrentSheet = ThisWorkbook.ActiveSheet
    Set MooSheet = ThisWorkbook.Sheets("Cab Templates")
    
    ' 直接复制目标Shape，粘贴到当前工作表的A1位置
    MooSheet.Shapes("VHPOPA").Copy
    CurrentSheet.Paste Destination:=CurrentSheet.Range("A1")
End Sub

优化写法（无需剪贴板） #

如果不想占用剪贴板，可以直接复制Shape到目标工作表并调整位置，效率更高：

Sub AddCabinet()
    Dim MooSheet As Worksheet, CurrentSheet As Worksheet
    Dim copiedShape As Shape
    
    Set CurrentSheet = ThisWorkbook.ActiveSheet
    Set MooSheet = ThisWorkbook.Sheets("Cab Templates")
    
    ' 复制Shape到当前工作表末尾
    MooSheet.Shapes("VHPOPA").Copy _
        After:=CurrentSheet.Shapes(CurrentSheet.Shapes.Count)
    ' 获取刚复制的Shape并调整位置到A1
    Set copiedShape = CurrentSheet.Shapes(CurrentSheet.Shapes.Count)
    copiedShape.Top = CurrentSheet.Range("A1").Top
    copiedShape.Left = CurrentSheet.Range("A1").Left
End Sub

关键说明 #

• 代码开头先记录CurrentSheet，确保是点击按钮时激活的工作表，不会因为后续切换到模板表而改变。
• 确保"Cab Templates"工作表存在，且其中确实有名为"VHPOPA"的Shape对象（比如图片、形状控件等）。

内容的提问来源于stack exchange，提问作者Geographos