Data grouping?

[idnoidno]

I want to filter the data, and then write the results of the grouping to the worksheet, can someone help me to adjust the code?for example, "for j=1 to ubound(ar,2)",
"worksheets(2)、worksheets(3)、worksheets(4). I am very grateful for any help.

ttt.xlsm

[mana]

What’s the problem?

[Paul_Hossler]

I think you're over complicating the macro

Unless you really want to use arrays, something simple might work just as well

Option Explicit

Sub t1()

Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long
Dim r1 As Range

i2 = 1
i3 = 1
i4 = 1

Set r1 = Worksheets(1).Cells(1, 1).CurrentRegion

Application.ScreenUpdating = False

Worksheets(2).Cells(1, 1).CurrentRegion.Clear
Worksheets(3).Cells(1, 1).CurrentRegion.Clear
Worksheets(4).Cells(1, 1).CurrentRegion.Clear

For i1 = 1 To r1.Rows.Count
    Select Case r1.Cells(i1, 2)
        Case Is < 5
            r1.Rows(i1).Copy Worksheets(2).Cells(i2, 1)
            i2 = i2 + 1
        Case Is < 10
            r1.Rows(i1).Copy Worksheets(3).Cells(i3, 1)
            i3 = i3 + 1
        Case Else
            r1.Rows(i1).Copy Worksheets(4).Cells(i4, 1)
            i4 = i4 + 1
    End Select
Next i1
Application.ScreenUpdating = True

End Sub

or

Sub t2()

Dim i1 As Long, ix As Long
Dim r1 As Range, rx As Range

Set r1 = Worksheets(1).Cells(1, 1).CurrentRegion

Application.ScreenUpdating = False

Worksheets(2).Cells(1, 1).CurrentRegion.Clear
Worksheets(3).Cells(1, 1).CurrentRegion.Clear
Worksheets(4).Cells(1, 1).CurrentRegion.Clear

For i1 = 1 To Worksheets(1).Cells(1, 1).CurrentRegion.Rows.Count
    Select Case r1.Cells(i1, 2)
        Case Is < 5
            ix = 2
        Case Is < 10
            ix = 3
        Case Else
            ix = 4
    End Select
    Set rx = Worksheets(ix).Cells(Worksheets(ix).Rows.Count, 1).End(xlUp)
    If Len(rx.Value) = 0 Then
        r1.Rows(i1).Copy rx
    Else
        r1.Rows(i1).Copy rx.Offset(1, 0)
    End If
Next i1

Application.ScreenUpdating = True

End Sub

[idnoidno]

Sub t1()
Dim ar, br, cr, dr, er
Dim i%, j%, n%, m%, k%
ar = [a1].CurrentRegion
ReDim br(1 To UBound(ar, 1), 1 To UBound(ar, 2))
ReDim cr(1 To UBound(ar, 1), 1 To UBound(ar, 2))
ReDim dr(1 To UBound(ar, 1), 1 To UBound(ar, 2))
er = Array(br, ccr, dr)
n = 1
m = 1
k = 1
For i = 1 To UBound(ar, 1)
    Select Case ar(i, 2)
        Case Is < 5
            For j = 1 To UBound(ar, 2)
                br(n, j) = ar(i, j)
            Next j
            n = n + 1
        Case Is < 10
            For j = 1 To UBound(ar, 2)
                cr(m, j) = ar(i, j)
            Next j
            m = m + 1
        Case Else
            For j = 1 To UBound(ar, 2)
                dr(k, j) = ar(i, j)
            Next j
            k = k + 1
    End Select
Next i
er = Array(br, cr, dr)
For i = 0 To UBound(er)
    With Worksheets(i + 2)
        .Cells(1, 1).Resize(UBound(ar, 1), UBound(ar, 2)) = er(i)
    End With
Next i
End Sub

Thanks for your answer.
The above is what I just thought.

[MagPower]

Just as an FYI, at the top of your Sub, you have "er = Array(br, CCR, dr)", when it should be "er = Array(br, CR, dr)" .

[Paul_Hossler]

Just as an FYI, at the top of your Sub, you have "er = Array(br, CCR, dr)", when it should be "er = Array(br, CR, dr)" .

1. That's the reason to use Option Explicit

2. This is an old post and while your comment is certainly valid, most likely the OP doesn't need it any more

3. Welcome to the forum - Glad to have you on board

4. Take a minute to read the tips and FAQ links in my sig

[MagPower]

Thanks Paul