Vba 根据条件将Excel工作表中的行复制到其他Excel文件中的行

我想首先告诉你，我花了至少2个小时阅读Stackoverflow和随机谷歌搜索结果上的不同问题/答案。我找不到我的具体问题的答案，尽管很多问题/答案都涉及类似的问题

每周，我都会根据特定的条件将行从一个Excel工作表手动复制到另一个Excel工作表中。在一列中，我感兴趣的单元格的值为“未完成”，在第二列中，我查找过去的到期日，即过期项目。如果两个条件都满足，我会将整行复制到另一个Excel文件中新创建的工作表中

Public Sub Copy_Relevant_Items()
Dim CurrentWorkbook As Workbook
Dim InputWS As Worksheet
Dim OutputWS As Worksheet

Set CurrentWorkbook = Workbooks(ActiveWorkbook.Name)
Set InputWS = CurrentWorkbook.Sheets("Overview")
Set OutputWS = CurrentWorkbook.Sheets("Relevant")

Dim criterion As String
criterion = "Done"
Dim cells As range, cell As range


'Find the last used row in a Column: column C in this example
With InputWS
  LastRow = .cells(.rows.Count, "C").End(xlUp).row
End With

Set cells = range("C2:C" & LastRow)

'Copy all the relevant rows into another sheet
For Each cell In cells
    If cell.Value <> criterion Then

        cell.EntireRow.Copy Destination:=OutputWS.range("A" & rows.Count).End(xlUp).Offset(1)

    End If
Next cell

我了解VBA的基本知识，并考虑编写一个宏，将相应的行复制到另一个Excel文件和新的工作表中，从而使我的生活更轻松。但是，我还不能编写一个相当复杂的宏：(

你能帮我解释一下如何写两个循环（某种形式的）首先查看第一列（查找值不是X的单元格）然后在第二列中查找过去的日期，然后复制符合这两个标准的行？这在VBA中也可能吗？我不要求整个宏，因为我想知道如何正确处理剩余的代码，但是这些循环对于初学者来说非常复杂，我非常感谢这里的一些指导。

提前感谢您抽出时间阅读这面文字墙

编辑：在检查excel easy（谢谢@maxhob17）后，我取得了一些进展。请查看此代码，以便了解我的进展。此代码根据第一个标准（状态=完成）获取所有相关行，并将它们复制到同一excel文件中的新工作表中

Public Sub Copy_Relevant_Items()
Dim CurrentWorkbook As Workbook
Dim InputWS As Worksheet
Dim OutputWS As Worksheet

Set CurrentWorkbook = Workbooks(ActiveWorkbook.Name)
Set InputWS = CurrentWorkbook.Sheets("Overview")
Set OutputWS = CurrentWorkbook.Sheets("Relevant")

Dim criterion As String
criterion = "Done"
Dim cells As range, cell As range


'Find the last used row in a Column: column C in this example
With InputWS
  LastRow = .cells(.rows.Count, "C").End(xlUp).row
End With

Set cells = range("C2:C" & LastRow)

'Copy all the relevant rows into another sheet
For Each cell In cells
    If cell.Value <> criterion Then

        cell.EntireRow.Copy Destination:=OutputWS.range("A" & rows.Count).End(xlUp).Offset(1)

    End If
Next cell

公共子副本\u相关项目（）
将当前工作簿设置为工作簿
将输入设置为工作表
将输出设置为工作表
Set current工作簿=工作簿（ActiveWorkbook.Name）
设置InputWS=CurrentWorkbook.Sheets（“概述”）
设置OutputWS=CurrentWorkbook.Sheets（“相关”）
作为字符串的Dim标准
criteria=“完成”
变暗单元格作为范围，单元格作为范围
'查找列中最后使用的行：本例中的C列
有输入
LastRow=.cells（.rows.Count，“C”）.End（xlUp）.row
以
设置单元格=范围（“C2:C”和最后一行）
'将所有相关行复制到另一个工作表中
对于每个单元格中的每个单元格
如果是单元格值标准，则
cell.EntireRow.Copy Destination:=OutputWS.range（“A”&行数）.End（xlUp）.Offset（1）
如果结束
下一个细胞

---

End Sub

您可以使用

AutoFilter（）

假设数据库从A列扩展到D列，并且日期在D列中，则可以编写代码

Option Explicit

Public Sub Copy_Relevant_Items()
    Dim InputWS As Worksheet, OutputWS As Worksheet
    Dim criterion As String

    Set InputWS = ActiveWorkbook.Sheets("Overview")
    Set OutputWS = ActiveWorkbook.Sheets("Relevant")
    criterion = "Done"

    With InputWS
        With .Range("A1:D" & .cells(.Rows.Count, 1).End(xlUp).Row) '<--| reference its columns A to C from row 1 down to column A last not empty row. Change A and D to your actual data limit columns index
            MsgBox .Address
            .AutoFilter Field:=3, Criteria1:="<>" & criterion '<--| filter column C cells with content different from 'Criterion'. change "3" to your actual relative position of "status" column inside your database
            .AutoFilter Field:=4, Criteria1:="<" & CLng(Date)   '<--| filter column D cells with content less than current date. change "4" to your actual relative position of "date" column inside your database
            If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy Destination:=OutputWS.Range("A" & Rows.Count).End(xlUp).Offset(1) '<--| if any cell filtered other than headers then copy them to 'OutputWS'
        End With
    End With
End Sub

选项显式
公共子副本相关项目（）
将输入设置为工作表，将输出设置为工作表
作为字符串的Dim标准
设置InputWS=ActiveWorkbook.Sheets（“概述”）
设置OutputWS=ActiveWorkbook.Sheets（“相关”）
criteria=“完成”
有输入
使用.Range（“A1:D”和.cells（.Rows.Count，1）.End（xlUp.Row）”，我可以建议您使用Power Query（如果您的Excel超过2010版），对于初学者来说非常容易使用。只需建立Excel连接，根据需要筛选您的条件，无需复制/粘贴，只需右键单击“更新”您已经完成了…嗨，简要概述：首先，您需要定义一个来表示您要检查的数据。然后您可以使用a来检查每一行。然后您可以使用语句检查第1列和第2列的两个条件。然后当IF为True时，您可以将该行复制到其他位置。OK you maxhob17，我将签出excel easy now:）请解释“在第二栏中查找过去的日期”实际上应该是什么意思。嗨，很抱歉没有正确解释。想象一下，有一列显示了截止日期。我想查找过去的到期日，即根据标准#1逾期的项目。我将对我的问题进行编辑以使其清楚。谢谢嗨，谢谢你的帮助！我将搜索有关如何正确使用AutoFilter（）的教程：）不客气。顺便说一句，如果您采用此解决方案，您可能希望将答案标记为已接受；-）是的，我现在就做！对不起。@BennyC，好的。您只需“单击答案旁边的复选标记，将其从灰色切换为已填写”谢谢，我找到了它。：）