Mass Delete/Paste Graphics in a Workbook
First, graphics are over cells, but they are not associated with the cells.
It would be much easier to name your graphics in some clever way that allows
you to loop through them using the name.
But given your premis,
you can loop through your shapes
Dim sh as Worksheet, sh1 as Worksheet
Dim v as Variant, v1 as Variant
Dim rng as Range, rng1 as Range
Dim shp as Shape, i as Long, j as Long
set sh = Worksheets("Sheet1")
set rng = sh.Range("A11, B22, C33")
for each shp in sh.Shapes
set rng1 = sh.range(sh.TopLeftCell, sh.BottomRightCell)
if not intersect(rng,rng1) is nothing then
shp.Delete
end if
Next
'
' now copy the shapes
'
v1 = Array("A11","B22","C33")
v = Array("P3","G19","W32")
j = lbound(v)
for i = 3 to 5
set sh1 = Worksheets("Sheet" & i)
set rng = sh1.Range(v(j))
for each shp in sh1.shapes
set rng1 = sh1.Range(shp.TopLeftCell, shp.BottomRightCell)
if not intersect(rng1,rng) is nothing then
shp.copy
sh.Select
sh.Range(v1(j)).Select
sh.Paste
exit for
end if
Next
j = j + 1
Next
--
Regards,
Tom Ogilvy
"Phil H" wrote in message
...
I need a macro to assign to a control button on Sheet1 to:
1.) Delete the graphics in cells A11, B22, C33, ..., etc.
2.) Paste the graphics from:
Sheet3/cellP3 to Sheet1/cellA11,
Sheet4/cellG19 to Sheet1/cell B22
Sheet5/cellW32 to Sheet1/cell C33
etc.?
There will be about 70 of these delete/pastes (updates).
What would the code be?
|