如何将一张表按某个字段的不同各取一定条数据？

刀剑如梦rxy123

表格见附件，我想按sheet11表中“号段”字段分类，每个号段取1000条数据放到同一个新建的sheet中，
下面代码只能提取出一个号段的，哪位大神帮我修改一下能取到全部14个号段的各1000条数据，在此谢过！

Sub chaifen()
    Dim i As Integer, hd As Range, wt As Worksheet, rng As Range, xrow As Integer
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "zhengli"
    Set wt = Worksheets("zhengli")
    Worksheets("sheet11").Range("a1:f1").Copy wt.Range("a1:f1")
    i = 2
    For Each hd In Worksheets("sheet2").Range("a1:a14")
        Do Until i = 1000
            xrow = wt.Range("a1").CurrentRegion.Rows.Count + 1
            Set rng = wt.Range(wt.Cells(xrow, "a"), wt.Cells(xrow, "f"))
            If hd.Value = Worksheets("sheet11").Cells(i, "f").Value Then
                Worksheets("sheet11").Cells(i, "f").Offset(0, -5).Resize(1, 6).Copy rng
            End If
        i = i + 1
        Loop
    Next hd
End Sub

刀剑如梦rxy123

顶顶顶来人啊啊

EH258369

看看再说！

wssanyecao

先排序  然后再countif