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

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

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

Cutting Rows Based On a Cell Value And Paste On Top of Specific Row

excel

vba

loops

copy-paste