Sub Test() Dim sr As ShapeRange Dim i As Long Set sr = ActiveSelectionRange For i = sr.Count To 1 Step -1 If sr(i).Type <> cdrRectangleShape Then sr.Remove i Next i sr.Move 1, 0 End Sub