Sub Макрос5()
    With Selection
    l = .Left
    p = .Left + .Width
    v = .Top
    n = .Top + .Height
    End With
    Dim ar() As String
    ReDim ar(0)
    For x = 1 To ActiveSheet.Shapes.Count
        With ActiveSheet.Shapes(x)
        If .Left > l Then
            If (.Left + .Width) < p Then
                If .Top > v Then
                    If (.Top + .Height) < n Then
                        ar(UBound(ar)) = .Name
                        ReDim Preserve ar(UBound(ar) + 1)
                    End If
                End If
            End If
        End If
        End With
    Next x
    If UBound(ar) < 2 Then
        MsgBox "В выделенной области менее 2 фигур!", vbInformation
        Exit Sub
    End If
    ReDim Preserve ar(UBound(ar) - 1)
    ActiveSheet.Shapes.Range(ar).Group
End Sub