Sub Test() Dim Target As Layer Dim s As Shape Dim idx As Long If ActivePage.Layers.Count = 1 Then MsgBox "Cannot delete a single layer" End If If ActiveLayer.Shapes.Count Then idx = 1 ' Determining the index number of the active layer For Each Target In ActivePage.Layers If Target Is ActiveLayer Then Exit For idx = idx + 1 Next Target ' Finding the index number of the target layer If idx = 1 Then idx = 2 Else idx = idx - 1 Set Target = ActivePage.Layers(idx) ActiveDocument.ClearSelection ActiveLayer.Shapes.All.AddToSelection ActiveSelection.Layer = Target End If ActiveLayer.Delete End Sub