Excel vba Shape Paste not work

Question

I trying to paste textbox from sheet1 to sheet2

Function footer()
Application.Volatile True
r = Application.Caller.Address
SheetName = Application.Caller.Parent.Name

    Select Case Range("Locale").Value
        Case "RU": boxx = Range("company").Value & Range("Locale")
        Case "EN": boxx = Range("company").Value & Range("Locale")
    End Select
Worksheets("Translations").Shapes(boxx).Copy
MsgBox Worksheets("Translations").Shapes(boxx).TextFrame.Characters.Text
ActiveSheet.Paste
End Function

Msgbox Looks ok but paste function do nothing, i tryed different ways

ActiveSheet.range("A1").Paste
ActiveSheet.range("A1").PasteSpecial
Worksheets(SheetName).Paste
Worksheets(SheetName).Range(r).Paste

All not working, just nothing appears in the sheet, whats is wrong?

If you are calling this function from a cell, it won't work. A UDF in a cell can't copy a shape. — Rory
Then it won't work, as I said. A UDF is not allowed to do that. I will post a workaround — Rory

Rory Rory · Accepted Answer · 2015-03-16T10:27:18

Although you can't copy and paste a shape, you can add a new shape and copy the text and formatting from the original - for example:

Function footer()
    Dim boxx                  As String
    Dim shpTo                 As Shape
    Dim shpFrom               As Shape

    Application.Volatile True

    Select Case Range("Locale").Value
        Case "RU": boxx = Range("company").Value & Range("Locale")
        Case "EN": boxx = Range("company").Value & Range("Locale")
    End Select
    Set shpFrom = Worksheets("Translations").Shapes(boxx)
    With Application.Caller
        Set shpTo = .Worksheet.Shapes.AddShape(shpFrom.AutoShapeType, .Left, .Top, shpFrom.Width, shpFrom.Height)
        shpTo.TextFrame.Characters.Text = shpFrom.TextFrame.Characters.Text
    End With
    shpFrom.PickUp
    shpTo.Apply
End Function

Excel vba Shape Paste not work

2 Answers