Loop to move rows to another sheet leaves one row not moved

I have some data, according to the VBA code, all the rows are divided inside the sheets, but one row remains.

All rows transfer to other sheets, only row number 4 is not transferred to other sheets.

Sub ap()
Dim mycell As Range
Dim myrange As Range
Worksheets("sheet2").Range("a1:z10000").Clear
Worksheets("sheet3").Range("a1:z10000").Clear
Worksheets("sheet4").Range("a1:z10000").Clear
Worksheets("sheet5").Range("a1:z10000").Clear
Set myrange = Worksheets("sheet1").Range("a3:a916")
For Each mycell In myrange
    If mycell.Value >= 12 Then
        If mycell.Value >= 24 Then
            mycell.Interior.ColorIndex = 4
            mycell.Resize(1, 16).Cut Destination:= _
              Worksheets("sheet2").Range("a1").Offset(Worksheets("sheet2").Rows.Count - 1, 0).End(xlUp).Offset(1, 0)
        Else
            mycell.Interior.ColorIndex = 5
            mycell.Resize(1, 16).Cut Destination:= _
              Worksheets("sheet3").Range("a1").Offset(Worksheets("sheet3").Rows.Count - 1, 0).End(xlUp).Offset(1, 0)
        End If
    Else
        mycell.Interior.ColorIndex = 6
        mycell.Resize(1, 16).Cut Destination:= _
          Worksheets("sheet4").Range("a1").Offset(Worksheets("sheet4").Rows.Count - 1, 0).End(xlUp).Offset(1, 0)
    End If
Next
Worksheets("sheet2").Columns.AutoFit
Worksheets("sheet3").Columns.AutoFit
Worksheets("sheet4").Columns.AutoFit
End Sub

Option Explicit
Sub Macro2()

    Dim wb As Workbook, ws As Worksheet, mycell As Range
    Dim n As Long, ci As Long
    
    Set wb = ThisWorkbook
    For n = 2 To 5
        wb.Sheets("Sheet" & n).Range("A1:Z10000").Clear
    Next
    
    Application.ScreenUpdating = False
    For n = 3 To 916
        Set mycell = wb.Sheets("Sheet1").Cells(n, 1)
        ci = 0
        If mycell >= 24 Then
            ci = 4
            Set ws = Sheets("Sheet2")
        ElseIf mycell.Value >= 12 Then
            ci = 5
            Set ws = Sheets("Sheet3")
        ElseIf Len(mycell) > 0 Then ' skip blanks
            ci = 6
            Set ws = Sheets("Sheet4")
        End If
        If ci > 0 Then
            mycell.Interior.ColorIndex = ci
            mycell.Resize(1, 16).Cut _
               Destination:=ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Next
    Application.ScreenUpdating = True
    
    For n = 2 To 4
        wb.Sheets("Sheet" & n).Columns.AutoFit
    Next
    MsgBox "Done"

End Sub

</details>