For some reason, occasionally the For...Next loop was skipping from B2 to B4 without checking B3 - I haven't a clue why, as when I rearranged the rows in random order it didn't do it every time. But changing the Cut to Copy and then clearing the values in the row seems to solve it:

Sub copy_if_matches_criteria()

    Dim wshSource As Worksheet, wshDest As Worksheet
    Dim rngCell As Range
     
    If Intersect([b:b], ActiveSheet.UsedRange) Is Nothing Then Exit Sub
     
    Set wshSource = ActiveSheet
    Set wshDest = Sheets.Add(before:=ActiveSheet)
    wshDest.Name = "TS"
     
    wshSource.Select
    For Each rngCell In Intersect([b:b], Range(Rows(2), Cells.SpecialCells(xlCellTypeLastCell)))
        If (rngCell.Value * 1 >= 300 And rngCell.Value * 1 <= 399) Or _
            (rngCell.Value * 1 >= 1100 And rngCell.Value * 1 <= 1199) Or _
            (rngCell.Value * 1 >= 4018 And rngCell.Value * 1 <= 4025) Or _
            (rngCell.Value * 1 = 4028) Or rngCell.Value * 1 = 4011 Then
            rngCell.EntireRow.Copy wshDest.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            rngCell.EntireRow.Value = Empty
        End If
    Next
     
    wshSource.[1:1].Copy wshDest.[a1]
    Intersect([b:b], ActiveSheet.UsedRange).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    wshDest.Select
     
End Sub
Got there in the end...


C