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.
与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…