Copy/pasting cells with shapes

Question

How can copy a shape along with the cell it is in? When I copy manually the shape follows the cell, but when I do it with a macro I get everything else but the shape.

Cells(sourceRow, sourceColumn).Copy
Cells(targetRow, targedColumn).PasteSpecial

...

Range("A1").copy
Range("B2").PasteSpecial Operation:=xlPasteAll

I've tried all I could think of... but the shape just won't move.

Recorded the manual copy/paste and this is what I got:

Range("A1").Select
Selection.Copy
Range("A3").Select
ActiveSheet.Paste

you may perform the copy manually while recording the macro. — keong kenshih
I just did, but didn't help much. I have pasted the recorded macro in the question. — jony
The recorded code should paste the shape into cell A3. Is this not the case? — kaybee99
It should, but do I have to select the cell? Can't I paste it directly to a cells() or a range()? — jony
Yes, you got to select the cell as Range/Cell did not have that "Paste" function supported — keong kenshih

kaybee99 kaybee99 · Accepted Answer · 2015-06-23T09:27:54

I would do something like this to avoid having to actually select the cell:

Sub MoveShape()

  Dim s As Shape
  Dim T, L, celWidth, shpWidth, celHeight, shpHeight As Double
  Dim rng As Range
  Dim ws as Worksheet

  Set s = ws.Shapes(1).Duplicate ''You'll have to get the index of the shape you want to copy 
  Set rng = Range("A3") ''Set this to your target range

  T = rng.Top
  L = rng.Left

  celWidth = rng.Width
  shpWidth = s.Width

  celHeight = rng.Height
  shpHeight = s.Height

  s.Top = T + (celHeight - shpHeight) / 2
  s.Left = L + (celWidth - shpWidth) / 2

End Sub

This will duplicate your shape, and put the resulting clone in the centre of your target range. You can change its position in the cell by modifying the s.Left and s.Top values.

You can now use Range("A3").Value = Range("A1").Value to copy the actual values of the cell to your target range

Copy/pasting cells with shapes

2 Answers