EXCEL如果单元格有值，则将行从表移动到另一个表

我正在开发一个exel模板（一个待办事项列表），有一段时间我一直在关注最后一个问题。 （这只是模板的一部分）

如果任务已完成，我希望将状态更改为“已完成”（通过下拉列表）

现在，如果状态行中的一个单元格的值为“Completed”，我希望它将整个表行移动到另一个表中，其中包含所有已完成的值

有人知道这是否可能吗？如果有，还有一些关于如何实现的线索吗

你会很感激的

你诚挚的， A

---

编辑：

我已经做了所有关于EXCEL的事情，如果单元格有值，请将行从一个表移动到另一个表

现在，我希望在代码的末尾，我的表再次“应用排序”。所以已经编写了自定义排序规则，我只想重新排序我的表

我想到了两种解决方案：

到桌边去

执行Ctrl+Alt+l

（这是为了重新应用当前排序设置）

在VBA中写入以再次对表进行排序。但这不需要再次编写排序规则，因为这是一件非常复杂的事情。 我找过了，自己也试过了，但我就是做不成。我已经为第一部分编写了很多代码。一切都准备就绪，我只需要最后一次修改就可以使我的待办事项清单完美无瑕

有人有线索吗

---

你的真挚，混蛋这是我的全部代码。我知道这看起来很多，可能有更简单的方法，但事实就是这样。如果有任何意见，请随时提出建议：）

（这是我第一次使用VBA）

事件后我的子程序

Public Sub MoveMacro(lstObj)
    'lstObj is the table reference
    If Not IsNull(lstObj) Then

        ResortTable

        If (ActiveCell.Value = "Completed") Then
            Dim SheetToPaste As String
            SheetToPaste = "CompletedSheet"

            'Remember the row that is activated for later
            Dim rng As Range
            Set rng = ActiveSheet.Range(Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row, 11))

            'Copy the range
            rng.Copy

            'Activate second Worksheet + First cell
            Worksheets(SheetToPaste).Activate
            ActivateFirstBlankCellInTable

            'Paste the row based on the selection (last subroutine)
            Selection.PasteSpecial

            'Ask the user if it wants the range to be deleted
            DeleteFromRow rng

            'ActivateSheet1 again
            Worksheets("Daily Task List").Activate

            'Resort the table
            ResortTable
        End If
    End If
End Sub

激活空白表中的第一个单元格

Public Sub ActivateFirstBlankCellInTable()
    Dim ws As Worksheet
    Set ws = ActiveSheet

    'loop through each cell untill you find empty cell
    For Each cell In ws.Columns(1).Cells
        If IsEmpty(cell) = True Then cell.Select: Exit For
    Next cell

End Sub

从表中删除范围

Public Sub DeleteFromRow(rng As Range)
    If Not IsNull(rng) Then
        Dim YesOrNoAnswerToMessageBox As String
        Dim QuestionToMessageBox As String

        QuestionToMessageBox = "The row will be copied to this table." & vbNewLine & "Do you want it to be deleted in the other table?"

        'promp a yes no messagebox to ask the user what it wants
        YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbYesNo, "Delete row or not")

        'Catch the reply (only yes necessary
        If YesOrNoAnswerToMessageBox = vbYes Then
             rng.Delete
        End If
    Else
        MsgBox "Error passing range"
    End If
End Sub

度假表（主代码）

检查表中是否有活动单元格

Function IsActiveCellInTable() As Boolean
    'Function returns true if active cell is in a table and
    'false if it isn't.
    Dim rngActiveCell
    Set rngActiveCell = ActiveCell

    Debug.Print IsActiveCellInTable
    'Test for table.
    'Statement produces error when active cell is not
    'in a table.
    On Error Resume Next
    rngActiveCell = (rngActiveCell.ListObject.Name <> "")
    On Error GoTo 0
    'Set function's return value.
    IsActiveCellInTable = rngActiveCell

End Function

感谢您帮助我入门，忙于VBA是件好事

---

您好，

是的，这是可能的。在stackoverflow中搜索了一下，发现这是一个主要的灵感（stackoverflow.com/questions/24632623/将行移动到另一个工作表，其中单元格等于工作表名称），您可以找到自己的解决方案来监视单元格范围的更改事件（请参阅下面的SO question stackoverflow.com/questions/409434/automatic-execute-an-excel-macro-on-a-cell-change），并编写一些代码将一行从一张工作表移动到另一张工作表（）和测试。如果您有更具体的问题，请返回您的代码，我们将很乐意帮助您解决。非常感谢！我已经编写了所有内容，但还有一个（奇怪的）问题。我将继续查找并尝试找到答案，然后我将发布我的答案：）除了最后一件事之外，一切都正常运行。为我的问题编辑了这篇文章

Public Sub ResortTable()
    'Check if cell is in table range
    If IsActiveCellInTable = False Then
        'If not move 1 cell above
        ActiveCell.Offset(0, -1).Select
    End If

    'Execute Sort
    sortExecute
End Sub

Function IsActiveCellInTable() As Boolean
    'Function returns true if active cell is in a table and
    'false if it isn't.
    Dim rngActiveCell
    Set rngActiveCell = ActiveCell

    Debug.Print IsActiveCellInTable
    'Test for table.
    'Statement produces error when active cell is not
    'in a table.
    On Error Resume Next
    rngActiveCell = (rngActiveCell.ListObject.Name <> "")
    On Error GoTo 0
    'Set function's return value.
    IsActiveCellInTable = rngActiveCell

End Function

Public Sub sortExecute()
    ActiveSheet.ListObjects("TaskList").AutoFilter.ApplyFilter
    With ActiveWorkbook.Worksheets("Daily Task List").ListObjects("TaskList").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub