Processing in vba

Question

I have some data, and the VBA code says that all the rows should be split between the sheets, but one row is still present.

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 ```

Answer 1

Try this:

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