Selecting shapes and images in specific range, grouping then pasting in a new worksheet retaining group status.

[trl123]

Hi,

I am trying to create a form that people can edit. Users will use various shapes and images in a range to create a diagram and I want to save it to a table in another worksheet. The code below almost does what I want except it pastes the group of shapes as a picture. I would like to be able to retain the group status so it can be modified in the future.

'COPY AND PASTE INFORMATION TO FS- FORGE DATA Worksheet
'COPY AND PASTE DIAGRAM
'Select images and shapes from diagram box.
Dim shp As Shape
Dim r As Range
Set r = Range("C60:AS79")
For Each shp In ActiveSheet.Shapes
If Not Intersect(Range(shp.TopLeftCell, shp.BottomRightCell), r) Is Nothing Then _
shp.Select Replace:=False
Next shp

'Create group of images and shapes from diagram box to create diagram and reselect.
Selection.Group.Select

'Name diagram.
gName1 = Range("AI2").Value
gName2 = Range("V2").Value
NewGroup = gName1 & "-" & gName2
Selection.Name = NewGroup

'Copy diagram
Selection.Copy

'Ungroup selection on INPUT worksheet
Selection.Ungroup

'Paste diagram
Sheets("FS- Forge Data").Activate
lastRow = ActiveSheet.ListObjects("Table1").Range.Rows.Count - 1
ActiveSheet.ListObjects("Table1").DataBodyRange(lastRow, 172).Select
Selection.PasteSpecial

Thanks in advance,
trl123

 

[Domenic]

Try replacing...

Selection.PasteSpecial

with

ActiveSheet.Paste

Hope this helps!

 

[trl123]

Thanks a lot. Works perfectly!