VBA Excel - copy object to last active sheet - excel

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.

Answer 1

.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

Answer 2

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

Answer 3

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...