Grouping/ungrouping collapses layers

It's my belief that this has been normal ops from the beginning. I don't agree with it but it goes along the same annoyance I mentioned elsewhere regarding shapes and layers. If all your shapes are on the same layer and you group them they move to the "Active" layer instead of just staying where they were in the first place. I have since corrected that stupid behavior with a macro. Works wonders.
Now back to this annoyance. While having the layer expanded to show all the shapes, group the shapes and it collapses. Why!
I did find that if you group the shapes using this macro it stays expanded. One could assign the cntrl+g shortcut to this macro instead of the default. That's what I did to solve the first mentioned annoyance. Now if I could figure out how to implement the following into the same macro I'd be golden. But don't really feel the need as I rarely have the "All pages, layers and shapes" checked. All I need to see is the "Current page, layers only"

Sub GroupLayerObjects()
Dim sr As ShapeRange
Set sr = ActiveSelectionRange
sr.Group
End Sub