Search code examples
vbaexcelactivexobjectname-collision

How to copy an ActiveX control over to another sheet preventing the name change of the control


I am using the code below to copy a command button from one sheet and paste it into another:

Sheets("SRC").HasACustomName.Copy
Sheets("TRGT").Range("O1").PasteSpecial

When I paste it, it get's renamed from HasACustomName to CommandButton1.

Can I either copy/paste it in a way that retains the name or change the name after pasting?


Solution

  • ActiveX

    You can copy an ActiveX Control from one sheet to another with the below code.

    Note: you cannot have two objects of the same name on one spreadsheet.

    Sub CopyActiveX()
        Application.ScreenUpdating = False
        Dim x As OLEObject, y As OLEObject
        Set x = Sheets("SRC").OLEObjects("HasCustomName")
        Set y = x.Duplicate
        Dim xName As String
        xName = x.Name
        y.Cut
        With Sheets("TRGT")
            .Paste
            .OLEObjects(.OLEObjects.Count).Name = xName
            .Activate
        End With
        Application.ScreenUpdating = True
    End Sub
    


    Form Control

    To copy a button from one sheet to another preventing the automatic name change use the below code. Excel by default gives a new name to a copied button (even on a different sheet) so you have to rename it to match the name of the button youre copying.

    Use CopyButton() sub to achieve it. There are 4 required parameters

    • from - sheet name to copy the button from
    • btnName - the name of the control you want to copy
    • toWorksheet - target worksheet
    • rng - target range to associate with the button

    Sub CopyPasteButton()
        CopyButton "SRC", "Button 1", "TRGT", "B10"
    End Sub
    
    Private Sub CopyButton(from As String, btnName As String, toWorksheet As String, rng As String)
        Application.ScreenUpdating = False
        Sheets(from).Shapes(btnName).Copy
        Sheets(toWorksheet).Activate
        Sheets(toWorksheet).range(rng).Select
        Sheets(toWorksheet).Paste
        Selection.ShapeRange.Name = btnName
        Application.ScreenUpdating = True
    End Sub