As it is, if you group several objects together, they all move to the "active layer." for example if I have several objects that are on multiple layers that I need to group for alignment, etc... and I want them to all stay on the layers they are set to.... they will all move to the "active layer" when they are grouped. Then I have to go back afterward and individually select them all and move them back to the layers they belong on....
Sub GroupShapeRange() 'group shapes from many layers align then ungroup back to respective layers
Dim sr As ShapeRange, s As Shape
Set sr = ActiveSelectionRange
For Each s In sr
s.Name = (s.Layer.Name)
Next s
ActiveSelection.Group
End Sub
----------------------------------------------------------------------
Sub UngroupMoveToRespectiveLayers()
sr.Ungroup
s.Layer = ActivePage.Layers(s.Name)