根据单元格值剪切行并粘贴到特定行的顶部

Question

我有一份人员名单，他们的部门范围从 3811 到 3933。

我正在尝试对所有内容进行排序，以便列表顶部是部门编号为 3831 到 3843 的所有员工，然后是空白行，然后是其他所有人。由于行按部门顺序显示，因此循环可以在到达部门 3844 时停止。到目前为止，这是我想出的，但它不起作用。

如果可能，我还想取部门 3827 的行并将其粘贴到上半部分的底部 (3831-3843)

人员行从第 6 行开始，部门在 D 列

a = Worksheets("Sheet1").Cells(Rows.Count, 5).End(xlUp).Row

For i = 6 To a
    If Worksheets("Sheet1").Cells(i, 4).Value >= 3831# And 
    Worksheets("Sheet1").Cells(i, 4).Value < 3844# Then
    Worksheets("Sheet1").Rows(i).Cut
    Worksheets("Sheet1").Cells(a + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("Sheet1").Rows(i).Delete
    [enter image description here][1]
End If
    Worksheets("Sheet1").Cells(i, 4) = 3844#
Next

 Application.CutCopyMode = False

在玩弄了 SJR 的答案之后，我想出了这段代码。问题是底部的所有单元格都以相反的顺序剪切和粘贴，所以它现在是从大到小，而不是从小到大。

a = Worksheets("Sheet1").Cells(Rows.Count, 4).End(xlUp).Row

With Worksheets("Sheet1")
a = .Cells(Rows.Count, 4).End(xlUp).Row

For i = a To 6 Step -1
    If .Cells(i, 4).Value < 3831# Or .Cells(i, 4).Value >= 3844# Then
        .Rows(i).Cut .Cells(a + 2, 1)
        .Rows(i).Delete
    End If
Next
End With

Answer 1

你可以试试这个，但我仍然无法完全理解你想要做什么。

Sub x()

With Worksheets("Sheet1")
    a = .Cells(Rows.Count, 5).End(xlUp).Row
    For i = a To 6 Step -1
        If .Cells(i, 4).Value >= 3831# And .Cells(i, 4).Value < 3844# Then
            .Rows(i).Cut .Cells(a + 1, 1)
            .Rows(i).Delete
            .Cells(i, 4) = 3844#
        End If
    Next
End With

End Sub