Group Shapes Rename Them - Loop Through Worksheets

[dj44]

Hi folks,

Good Monday.

How can I loop through my worksheets looking for specific shapes and make a group and rename them as below


Each worksheet has a box1, box2 and box 3 - this is a normal autoshape

I would like to group them and name then as a "PartsDescriptionBox"

Sub GroupShapesRename()

' Select the Shapes -  Group & Rename
    Dim oShape       As Shape
    Dim i            As Long

    Dim wksht        As Worksheet


    For Each wksht In Worksheets

    wksht.Shapes.Range(Array("Box1", "Box2", "Box3")).Select
    wksht.Selection.ShapeRange.Group.Select
    wksht.Selection.ShapeRange.Name = "DescriptionBox"

Next wksht

End Sub

I have got stuck on this and not sure what to do now - I tried with the macro recorder as usual but nothing yet

Thank you

[Bob Phillips]

Not sure how you can name shapes Box1,2,3 as these are cell references, but this works for me

Sub GroupShapesRename()
 ' Select the Shapes -  Group & Rename
Dim wksht        As Worksheet
     
    For Each wksht In Worksheets
         
        wksht.Activate
        wksht.Shapes.Range(Array("Box 1", "Box 2", "Box 3")).Select
        Selection.ShapeRange.Group.Select
        Selection.ShapeRange.Name = "DescriptionBox"
    Next
End Sub