Sub DeleteNamedRanges()
Dim nm As Excel.Names
Dim rng As Excel.Range
Application.ScreenUpdating = False
With Sheets("Sheet1")
Set rng = .Range("E6:BX2000")
For Each nm In activeworkbooks.Name
If Intersect(rng, Range(nm.Name)) Then nm.Delete
Next nm
End With
Set rng = Nothing
Application.ScreenUpdating = True
End Sub