根据多个条件将多个Excel工作表中的行复制到摘要页面

Question

提前感谢您阅读本文，以及您可能给予的任何帮助。我不知道任何VBA，但我从这些论坛中找到了一些代码。

我正在尝试将三个源表（Ortigas，Franchise和Movu）中的所有行复制到Summary选项卡中，如果它们符合两个条件：

（1） - date =今天的日期，如A列，
所示 （2） - D栏中显示的收件人与“摘要！”B3中的下拉列表中的内容相匹配。

Screenshot of sample data from the source sheets

  

Summary page with drop down

  

附件是我的工作簿。workbook

这是我到目前为止的代码，但由于以下行而导致语法错误：

Set ws1 = Sheets(Array("Ortigas", "Franchise", "Movu")) Set ws2 = Sheets("Summary"): ws1.Select

我认为这是因为我放了一张纸而不是一张纸。我尝试了不同的迭代来修复它，但它不起作用。如何让ws1引用一系列工作表？

希望有一个能帮助我的善良灵魂！非常感谢你。

    Sub Test()
    Dim sheetsArray As SheetsA
    Set sheetsArray = Sheets(Array("Ortigas", "Franchise", "Movu"))

    Dim target As Range
    Dim sheetObject As Worksheet

    ' change value of range 'a1' on each sheet from sheetsArray
    For Each sheetObject In sheetsArray
        Set target = sheetObject.Range("A1")
        target.Value = "Test"
    Next sheetObject
End Sub

Sub FindNext_Copy_Data()
    Dim Last_Row As Long, Next_Row As Long, First_Find As Long
    Dim Range_Value As Range, a As Variant, i As Integer
    Dim Today_Date As Date, ws1 As Worksheet, ws2 As Worksheet
    Application.ScreenUpdating = False
    Today_Date = Date
    Set ws1 = Sheets(Array("Ortigas", "Franchise", "Movu")) Set ws2 = Sheets("Summary"): ws1.Select
    Next_Row = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
    Last_Row = ws1.Range("A" & Rows.Count).End(xlUp).Row
    Set Range_Value = Range(Cells(1, "A"), Cells(Last_Row, "A"))

    With Range_Value
        Set a = .Find(What:=Today_Date, LookAt:=xlPart)
        First_Find = a.Row
        Do
            a.EntireRow.Copy Destination:=ws2.Cells(Next_Row, 1): Next_Row = Next_Row + 1
            Set a = .FindNext(a)
        Loop While (a.Row <> First_Find)
    End With

    ws2.Select: Set ws1 = Nothing: Set ws2 = Nothing: Set Range_Value = Nothing
    Application.ScreenUpdating = True
End Sub

Answer 1

以下行不会使用Array参数进行编译：

Set ws1 = ActiveWorkbook.Sheets(Array("Ortigas", "Franchise", "Movu")) 

您必须选择其中一个工作表才能工作（比如说＆＃34; Ortigas＆＃34;）;即：

Set ws1 = ActiveWorkbook.Sheets("Ortigas")

你的第一个.Find命令应该有附加参数：

Set a = .Find(What:=Today_Date, LookAt:=xlPart, LookIn:=xlFormulas)

要确保在第二个条件为真时复制，您可以将复制命令嵌套在if语句中：

If ws1.Cells(a.row,"D").Value=ws2.Cells(3,"B").Value Then
   a.EntireRow....
Endif

此外，您不需要将ws1和ws2设置为Nothing。一旦子例程返回，这些变量无论如何都会超出范围，因此您可以删除这些语句。