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

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

我有基本的编程知识，并提出了这个宏

    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

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

---

第二，当我从D列的下拉列表中将行标记为“finaled”时，这种移动是否会自动发生？还是每次都必须手动运行宏

在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

Private子工作表\u更改（ByVal目标作为范围）
将wsData设置为工作表
将wsDest设置为工作表
Dim rngCheck As范围
变暗RNG更改为范围
变光电池作为量程
变暗rngMove As范围
设置wsData=Me
设置wsDest=Me.Parent.Sheets（“最终”）
设置rngCheck=wsData.Range（“D19”，wsData.Cells（wsData.Rows.Count，“D”）.End（xlUp））
如果rngCheck.Row<19，则退出子项“无数据”
Application.EnableEvents=False
返回可重入事件时出错
设置rngChanged=Intersect（rngCheck，目标）
如果没有rngChanged，则不算什么
对于rngChanged.Cells中的每个ChangedCell
如果LCase（Trim（ChangedCell.Value））=“finaled”，则
选择案例（rngMove为Nothing）
大小写为True:Set rngMove=ChangedCell
其他情况：设置rngMove=Union（rngMove，ChangedCell）
结束选择
如果结束
下一个变更单元
如果不是，爱就是一切
使用rngMove.EntireRow
复制
wsDest.Cells（wsDest.Rows.Count，“A”）.End（xlUp）.Offset（1）.粘贴特殊XLPasteValue
.删除xlShiftUp
以
如果结束
如果结束
可重入事件：
Application.EnableEvents=True
端接头

现在，当您将D列中的单元格更改为“finaled”时，它将自动移动到

finaled

工作表

---

此外，您在

FINALED

工作表上丢失数据的原因是因为这一行：

Sheets（“FINALED”）.Range（“A2:Z500”）.ClearContents

，我没有包括它，因为我认为您实际上并不需要它。

您所说的

是什么意思？它只复制信息行，当我从原始工作表中删除行时，最终工作表中的数据将丢失

？如果将数据复制到最终工作表，那么数据就在那里，如果删除另一工作表上的某些内容，数据就不会消失。对于您的部分问题，您可能希望查看。我的意思是，数据行基本上是“复制并粘贴”到最终工作表上的，并且它仍然保留在我的主工作表上。我不希望复制数据行，我希望将其从主工作表中剪切出来，并输入最终工作表。第二部分，一旦它出现在我的最终工作表上，我已经从我的主工作表中手动删除了它。但当我再次运行宏时，（因为数据行不再在主工作表上），最终工作表将更新，并且我从主工作表中删除的数据行不再出现在最终工作表上。因此，这非常有效，我非常激动，直到我关闭并重新打开它。：/我保存了它，当我重新打开excel文档时，“最终”选项卡完全为空。实际上，我已经“完成”了27个项目，这些项目从活动选项卡中删除，并出现在“完成”选项卡上，正如我所希望的那样。你知道我重新打开文档时它们消失的原因吗？除非你有另一个宏运行在

workbook\u open

、

workbook\u close

或

sheet\u activate

上，或者类似的宏可以清除数据（比如前面提到的

ClearContents

行），否则它们没有理由消失。