Vba 基于多个条件将多个excel工作表中的行复制到摘要页面

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

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

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

附件是我的工作手册

这是到目前为止我所掌握的代码，但由于以下代码行，它显示语法错误：

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

子测试（）
暗淡的床单如床单A所示
Set sheetsArray=张数（数组（“Ortigas”、“特许经营”、“Movu”））
作为射程的弱小目标
将图纸对象设置为工作表
'从sheetsArray更改每张图纸上范围'a1'的值
对于sheetsArray中的每个sheetObject
设置目标=sheetObject.Range（“A1”）
target.Value=“测试”
下一页对象
端接头
子FindNext\u Copy\u数据（）
模糊最后一行的长度，下一行的长度，第一行的长度
Dim Range_值作为范围，a作为变量，i作为整数
Dim Today\u日期作为日期，ws1作为工作表，ws2作为工作表
Application.ScreenUpdating=False
今天=日期
设置ws1=工作表（数组（“Ortigas”、“特许经营”、“Movu”））设置ws2=工作表（“摘要”）：ws1。选择
Next_Row=ws2.Range（“A”&Rows.Count）.End（xlUp）.Row+1
Last_Row=ws1.Range（“A”&Rows.Count）.End（xlUp）.Row
设置范围值=范围（单元格（1，“A”）、单元格（最后一行，“A”））
具有范围_值
设置a=.Find（What:=今天\日期，LookAt:=xlPart）
First_Find=a.行
做
a、 EntireRow.Copy Destination:=ws2.Cells（下一行，1）：下一行=下一行+1
设置a=.FindNext（a）
循环While（a.行优先\u查找）
以
ws2.Select:Set ws1=Nothing:Set ws2=Nothing:Set Range\u Value=Nothing
Application.ScreenUpdating=True
端接头

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

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

你必须选择一张工作表，让它工作（说“Ortigas”）；即：

您的第一个.Find命令应具有附加参数：

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

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

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

---

此外，您不需要将ws1和ws2设置为Nothing。子例程返回后，这些变量仍超出范围，因此您可以删除这些语句。

为了澄清，摘要页面应显示2017年5月17日源表中的所有行，带有recipient=“Ortigas ATM”以及您计划如何运行代码？工作表。选择更改？你也可以分享你的电子表格吗？有多“清楚”的地方出了问题？您是否希望我们构建您的环境来运行您的代码，这样我们就可以看到哪里出了问题，或者您是否准备好分享您认为的错误以及错误的表现形式？谢谢您的回复。我已经附上了工作表，并用以下信息编辑了我的帖子：我得到的语法错误。下面一行有一个错误：Set ws1=Sheets（数组（“Ortigas”、“特许经营”、“Movu”））Set ws2=Sheets（“摘要”）：ws1.SelectI添加了一个表单按钮，以便在下拉列表中每次更改时都可以使用它来运行宏。非常感谢您的帮助！我会考虑你的建议。然而，对我来说，从所有源工作表中提取数据是非常重要的，而不仅仅是从一个工作表中提取数据。有没有办法让代码从一组工作表中编译数据？您需要另一个循环来一次完成每个工作表。谢谢！我试试看。

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