excel Copy shapes from one worksheet to another

Question

I am trying to use a macro to copy all the shapes (images) from a worksheet to another. I used the record macro to do it, but it always gives an aleatory name to the shape making it impossible to reproduce it when we don't know the name of shapes.

It may also help to read through [how to avoid `.Select`/`.Activate`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). — BruceWayne, Feb 23 '18 at 15:08

Gary's Student · Accepted Answer · 2018-02-23T17:06:43.290

7

This will copy all the shapes from Sheet1 to Sheet2:

Sub CopyShape()
    Dim s As Shape
    For Each s In Sheets("Sheet1").Shapes
        s.Copy
        Sheets("Sheet2").Paste
    Next s
End Sub

Once the copy is complete, you can position them as you like or rename them as you like.
(An alternative is just to make a copy of the entire worksheet.)

EDIT#1:

This code will also automatically assign Names and positions to the copied Shapes:

Sub CopyShape()
    Dim shp1 As Shape, nombre As String
    Dim s1 As Worksheet, s2 As Worksheet
    Dim shp2 As Shape

    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")

    For Each shp1 In s1.Shapes
            nombre = shp1.Name
            shp1.Copy
            s2.Paste
            Set shp2 = s2.Shapes(s2.Shapes.Count)
            shp2.Name = nombre
            shp2.Top = shp1.Top
            shp2.Left = shp1.Left
    Next shp1
End Sub

Be careful to avoid name conflicts if you perform re-copies.

edited Feb 23 '18 at 17:06

answered Feb 23 '18 at 15:10

Gary's Student

95,722
10
59
99

the copy / paste works fine thank you a lot. But this answer puts the shapes in the left corner and what I was looking for for to put them in the same position they had in the source worksheet – Hugo Silva Feb 23 '18 at 16:49
@HugoSilva See my **EDIT#1** – Gary's Student Feb 23 '18 at 17:07
Set shp2 = s2.Shapes(s2.Shapes.Count) returns me error (object required) – Hugo Silva Feb 23 '18 at 17:26
@HugoSilva I can't reproduce the error you are seeing. – Gary's Student Feb 23 '18 at 17:35
@HugoSilva Try starting with no shapes on `Sheet2` – Gary's Student Feb 23 '18 at 17:48
sheet 2 is a blank sheet. still not working.... there is not a workaround? – Hugo Silva Feb 23 '18 at 18:16
@HugoSilva are you using `Sheet2` or `Sheet 2`? – Gary's Student Feb 23 '18 at 19:18
neither :) I am using sheets with given names. I managed to resove the issue according to the info on this link https://excelribbon.tips.net/T011333_Copying_Pictures_with_a_Macro.html. Thanks for your help! – Hugo Silva Feb 25 '18 at 21:59

score 1 · Answer 2 · answered Jul 23 '22 at 22:39

I've added the means to place the Shape in the target Sheet at about the same location. Below is how I use it.

    Private Sub CopyShape(ByVal shp_source As Shape, _
                          ByVal wsh_target As Worksheet, _
                          ByRef shp_target As Shape)
    ' -------------------------------------------------------------------
    ' Copies the Shape (shp_source) to Worksheet (wsh_target) and returns
    ' the target Shape (shp_target). Places the  Shape on the target
    ' sheet at the same cell (row/column) as the source Shape.
    ' -------------------------------------------------------------------
        Dim rng As Range

        Set rng = wsh_target.Cells(shp_source.TopLeftCell.Row, shp_source.TopLeftCell.Column)
        shp_source.Copy
        wsh_target.Paste rng
        Set shp_target = wsh_target.Shapes(wsh_target.Shapes.Count)
        With shp_target
           .Name = shp_source.Name
           .Top = shp_source.Top
           .Left = shp_source.Left
        End With

    End Sub

excel Copy shapes from one worksheet to another

2 Answers2

Linked