Sub DeleteExcess()
Application.ScreenUpdating = False
Dim lRow As Long, cRow As Long
With ActiveSheet
  lRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
  For cRow = lRow To 5 Step -1
    Select Case .Cells(cRow, 1).Value
      Case 5000 To 5999, 7500 To 8299, 8400 To 9599, 9700 To 9999
        .Cells(cRow, 1).EntireRow.Delete
      Case Else
    End Select
  Next
End With
Application.ScreenUpdating = True
End Sub