Reputation: 355
I want to copy all shapes from one worksheet and paste them on another worksheet at the same position. The shapes can be rectangular callouts or pictures.
So far, I know how to loop through all shapes in my old worksheet:
Dim s As Shape
For each s in Activesheet.Shapes
...
Next
How do I copy and paste the shapes at the same position in another worksheet, say Sheets("new")?
Upvotes: 3
Views: 18168
Reputation: 710
The below code should get you going. Be aware that I'm using the internal sheet name in the code. (Sheet1
and Sheet2
. The names before the brackets in the Project Explorer)
I used a bit of a workaround to avoid working with selections: You need to set the name of the shape first, because if it still has the standard name (e.g. "Oval 3") the name gets changed ("Oval 4"). In the end you can restore the original name of the shapes in both sheets.
Sub CopyShapes()
Dim s As Shape
Dim OriginalName As String
For Each s In Sheet1.Shapes
OriginalName = s.Name
s.Name = "FixedName"
s.Copy
Sheet2.Paste
Sheet2.Shapes("FixedName").Top = s.Top
Sheet2.Shapes("FixedName").Left = s.Left
s.Name = OriginalName
Sheet2.Shapes("FixedName").Name = OriginalName
Next s
End Sub
Edit: Adjusted the code to avoid the use of Selection.
as required in the comments
Upvotes: 5
Reputation: 2607
As far as I'm aware, there is no specific method to copy all of them. You could try the regular .Copy Destination:=...
method, but I'm not positive this will work.
The alternative is to just generate a new shape on the new sheet with identical properties to the desired shape. As you loop through the shapes on your current sheet, you would just need to create new shape objects with all of the same properties.
The most effective method (although this depends slightly on your intentions) is just to copy the original worksheet, instead of generating a fresh sheet. This will pull all the shapes (and other data) to the new sheet with all location and properties kept identical. If you just need the shapes and none of the cell data, you can copy the sheet and then add NewSheet.UsedRange.ClearContents
which will remove all the data but leave formatting intact.
Upvotes: 0