VBA Excel - copy object to last active sheet

Question

I have an object located on a different sheet, which I would like to copy to the last active sheet. Unfortunately, the code I have throws an error:

Object doesn't support this property or method

Sub AddCabinet()
Dim MooSheet, CurrentSheet As Worksheet
Set CurrentSheet = ThisWorkbook.ActiveSheet
Set MooSheet = ThisWorkbook.Sheets("Cab Templates")

MooSheet.Shapes.Range(Array("VHPOPA")).Select
Selection.Copy
CurrentSheet.Range("A1").Paste
End Sub

How can I copy an object to my previous current sheet? I have a few sheets with the same buttons.

A range has no `Paste`-method, you need to use `CurrentSheet.Paste`. Shape will be placed into the current active cell. See https://stackoverflow.com/a/48950861/7599798 — FunThomas, Sep 20 '22 at 15:34

Warcupine · Answer 1 · 2022-09-20T15:37:52.160

2

.paste is a worksheet method, not a range method, that is where the error is coming from.

We can remove all the Selects to make this a bit cleaner.

    Dim MooSheet As Worksheet, CurrentSheet As Worksheet
    Set CurrentSheet = ThisWorkbook.ActiveSheet
    Set MooSheet = ThisWorkbook.Sheets("Cab Templates")
    MooSheet.Shapes("VHPOPA").Copy
    CurrentSheet.Paste

edited Sep 20 '22 at 15:37

answered Sep 20 '22 at 15:34

Warcupine

4,460
3
15
24

Yes but how about if I want to paste the object at the current range? – Geographos Sep 20 '22 at 15:42
`CurrentSheet.Paste Selection` – Warcupine Sep 20 '22 at 15:44

score 1 · Answer 2 · answered Sep 20 '22 at 15:34

Before copying the object need to be there in that sheet, solve the problem... try this...

Sub AddCabinet()
Dim MooSheet, CurrentSheet As Worksheet
Set CurrentSheet = ThisWorkbook.ActiveSheet
Set MooSheet = ThisWorkbook.Sheets("Cab Templates")

MooSheet.Select
MooSheet.Shapes.Range(Array("VHPOPA")).Select
Selection.Copy

CurrentSheet.Select
Range("A1").Select
ActiveSheet.Paste
End Sub

Hope it Helps...

score 1 · Accepted Answer · answered Sep 21 '22 at 08:11

Copy Shapes

Can you even get rid of Select and Activate when copying multiple shapes? I couldn't.
My idea was to copy the shape(s) and restore the worksheets initial selections.
The array is useful to copy multiple shapes. Note that if you don't explicitly use the array function as the parameter for the Shape.Range property, you need to evaluate the array by putting it into parentheses, if its variable is declared as a variant without parentheses i.e.:
```
Dim shpArr() As Variant... sws.Shapes.Range(shpArr).Select
' or:
Dim shpArr As Variant  ... sws.Shapes.Range((shpArr)).Select 
```

The Flow

Exit if the workbook containing this code (ThisWorkbook) is not the active workbook (ActiveWorkbook). Exit if the active sheet (ActiveSheet) is not a worksheet. Reference the active sheet i.e. the destination worksheet.
Reference the source worksheet. Exit if it's the destination worksheet.
Reference the destination Selection to restore after the job is done. Reference the destination cell. Activate it, if it's not active.
Select the source worksheet. Reference its Selection to restore it after the job is done. Select all shapes whose names are in the array and copy them using Selection.
Activate the destination worksheet and paste. Restore its initial selection using Select.
Select the source workbook to restore its initial selection using Select.
Select the destination worksheet.

Sub AddCabinet()
            
    ' Define constants.
    Const sName As String = "Cab Templates"
    Const dFirstCellAddress As String = "A1"
    Dim shpArr() As Variant: shpArr = Array("VHPOPA")
    'Dim shpArr() As Variant: shpArr = Array("Oval 1", "Oval 2")
            
    ' Reference ThisWorkbook's active sheet, the destination worksheet ('dws').
    Dim wb As Workbook: Set wb = ThisWorkbook
    If Not wb Is ActiveWorkbook Then Exit Sub ' another workbook is active
    If Not TypeOf ActiveSheet Is Worksheet Then Exit Sub ' not a worksheet
    Dim dws As Worksheet: Set dws = wb.ActiveSheet ' or 'ActiveSheet'
    
    ' Reference the source worksheet ('sws')
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    If sws Is dws Then Exit Sub ' source and destination are the same
    
    'Application.ScreenUpdating = False
    
    ' Reference the destination cell ('dCell') and activate if not active.
    Dim dSel As Object: Set dSel = Selection ' store
    Dim dCell As Range: Set dCell = dws.Range(dFirstCellAddress)
    If Not dCell Is ActiveCell Then dCell.Activate ' ensure it's active
    
    ' Copy.
    sws.Select
    Dim sSel As Object: Set sSel = Selection ' store
    sws.Shapes.Range(shpArr).Select
    Selection.Copy
    
    ' Paste.
    With dws
        .Activate
        .Paste
    End With
    If Not dSel Is Nothing Then dSel.Select ' restore
    
    sws.Select
    If Not sSel Is Nothing Then sSel.Select ' restore
    
    dws.Select

    'Application.ScreenUpdating = True

End Sub

VBA Excel - copy object to last active sheet

3 Answers3

Copy Shapes