在Excel中，我怎样才能有条件地剪切一行数据并将其永久移动到另一个工作表中？

我有一个列出我所有项目的工作表。 当我从列D中的下拉列标记了一行（项目）为“Finaled”时，我希望将整行移到我的“Finaled”工作表中，并永久保留在该工作表上。

我有基本的编程知识，并拿出这个macros…

Sub Finaled() Dim i, LastRow Sheets("FINALED").Range("A2:Z500").ClearContents For i = 19 To LastRow If Sheets("ACTIVE").Cells(i, "D").Value = "Finaled" Then Sheets("ACTIVE").Cells(i, "D").EntireRow.Copy Destination:=Sheets("FINALED").Range("A" & Rows.Count).End(xlUp).Offset(1) End If Next i End Sub 

…但是这并不像我想要的那样工作。 第一个问题是它只复制了一行信息，当我手动删除主工作表中的行时，下一次运行macros时，我的Finaled工作表上的数据将丢失原来的复制行。 我希望它完全切断数据行并将其移动到我的“Finaled”工作表，并永久保留在那里。

其次，只要我在列D中的下拉列表中将该行标记为“结尾”，该移动是否会自动发生？ 或者我必须每次都手动运行macros？

Answer 1

在VBA编辑器中，双击名为ACTIVE的工作表，将显示该工作表的代码模块（不是它与标准模块不同）：

然后在该表单模块中，粘贴以下代码：

 Private Sub Worksheet_Change(ByVal Target As Range) Dim wsData As Worksheet Dim wsDest As Worksheet Dim rngCheck As Range Dim rngChanged As Range Dim ChangedCell As Range Dim rngMove As Range Set wsData = Me Set wsDest = Me.Parent.Sheets("FINALED") Set rngCheck = wsData.Range("D19", wsData.Cells(wsData.Rows.Count, "D").End(xlUp)) If rngCheck.Row < 19 Then Exit Sub 'No data Application.EnableEvents = False On Error GoTo ReEnableEvents Set rngChanged = Intersect(rngCheck, Target) If Not rngChanged Is Nothing Then For Each ChangedCell In rngChanged.Cells If LCase(Trim(ChangedCell.Value)) = "finaled" Then Select Case (rngMove Is Nothing) Case True: Set rngMove = ChangedCell Case Else: Set rngMove = Union(rngMove, ChangedCell) End Select End If Next ChangedCell If Not rngMove Is Nothing Then With rngMove.EntireRow .Copy wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues .Delete xlShiftUp End With End If End If ReEnableEvents: Application.EnableEvents = True End Sub 

现在，当您将D列中的单元格更改为“结尾”时，它将自动移至FINALED工作表。

另外，你在FINALED工作表上丢失数据的原因是因为这一行： Sheets("FINALED").Range("A2:Z500").ClearContents我没有包含的Sheets("FINALED").Range("A2:Z500").ClearContents ，因为我不认为你真的想要那。