Sub GroupItems()
 
 
 
	'*************************************
 
	'**** Code from VisibleVisual.com ****
 
	'*************************************
 
	On Error Resume Next
 
 
 
	UngroupGroup "GROUPSHAPE"
 
	Dim shpRange As ShapeRange
 
	Dim strArray As String
 
	strArray = ""
 
	For Each shp In ActiveSheet.Shapes
 
 
 
	If shp.Name Like "SHAPE*" Then
 
	'This function only groups shapes that start with the name SHAPE... Change shape to 8 to group all shapes
 
	If shp.Visible = True Then 'If a shape is not visible then it will not be grouped
 
	'Now create a stringarray
 
	If strArray = "" Then
 
	strArray = shp.Name
 
	Else
 
	strArray = strArray & "," & shp.Name
 
	End If
 
	End If
 
	End If
 
	Next
 
	'The stringarray with all shapes is completed and needs to be converted to a reall array
 
	'The same method can be used to select multiple shapes
 
	Dim x As Variant
 
	Dim sha As Shape
 
 
 
	x = Split(strArray, ",")
 
	Set sha = ActiveSheet.Shapes.Range((x)).Group
 
 
 
	sha.Name = "GROUPSHAPE"
 
	sha.Select 'All visible shapes where the name starts with SHAPE have been grouped
 
 
 
	End Sub
 
 
 
	Sub UnGroupItems()
 
	UngroupGroup "GROUPSHAPE"
 
	End Sub
 
 
 
	Function UngroupGroup(ByVal ShapeGroupName As String) As Boolean
 
	On Error GoTo errorhandler
 
	Dim shpRange As ShapeRange
 
	Dim sh As Shape
 
 
 
	For Each sh In ActiveSheet.Shapes
 
	If sh.Name = ShapeGroupName Then sh.Ungroup: UngroupGroup = True: Exit Function
 
	Next
 
	Exit Function
 
	errorhandler:
 
	UngroupGroup = False
 
	End Function