excel - 需要 VBA 协助根据表 1 中的值将数据复制到表 2 中的一行，并从表 1 中删除原始数据

Question

我在 VBA 代码方面相对缺乏经验，但是有一个我试图根据行中列出的项目的“状态”来组织的工作簿。

我在“M”列中有一个下拉框，允许用户选择“HOLD”或“RELEASED”...根据此值，需要将行项目复制并粘贴到工作表 2 中的同一行中，如果value = "RELEASED"(行项目范围示例为 ("B7:N7")(工作表的格式完全相同)。我有这方面的代码，但我需要从工作表中删除 "RELEASED"行项目1 复制并粘贴到工作表 2 后。

这是我所拥有的...(零件暂存日志 = 表 1 ...已发布的部件日志 = 表 2)

Public Sub CopyPasteRows()

Sheets("Parts Staging Log").Select
' Find the last row of data
FinalRow = Range("B828").End(xlUp).Row
' Loop through each row
For x = 7 To FinalRow
' Decide to copy based on column M value "RELEASED"
ThisValue = Range("M" & x).Value
If ThisValue = "RELEASED" Then
Range("B" & x & ":BM" & x).Copy
Sheets("Released Parts Log").Select
NextRow = Range("B828").End(xlUp).Row + 1
Range("B" & NextRow).Select
ActiveSheet.Paste
Sheets("Parts Staging Log").Select
End If
Next x

End Sub

如果有人可以帮助我删除原始订单项，那就太好了。其他意见也接受!

谢谢!

Answer 1

我对此的看法:删除循环(太慢)并用自动过滤器替换

Public Sub CopyPasteRows()
Dim FinalRow As Long

With Sheets("Parts Staging Log")
' Find the last row of data
    FinalRow = .Range("B828").End(xlUp).Row
    .Range("B6:BM" & FinalRow).AutoFilter
    .Range("B6:BM" & FinalRow).AutoFilter field:=12, Criteria1:="RELEASED"
    .Range("B7:BM" & FinalRow).SpecialCells(xlCellTypeVisible).Copy Sheets("Released Parts Log").Range("B828").End(xlUp).Offset(1)
    .Range("B7:BM" & FinalRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .Range("B6:BM" & FinalRow).AutoFilter    
End With


End Sub