搜索多个短语；跨多个工作表复制到单个工作表

Question

我正在使用 Microsoft Excel 来跟踪任务。我为每项工作使用不同的“工作表”。该结构与列和数据有关。我一直在尝试创建一个 VBA 脚本来完成以下任务：

1. 在工作表 1 - X 中连续搜索“未结”或“逾期”值
2. 将具有这些值的所有行复制到一张从第 3 行开始的工作表（例如分类帐）中（这样我就可以添加模板的标题）
3. 添加带有工作表名称的 A 列，以便我知道它来自什么工作。
4. 把这件事写在我的心上 强迫性行为 乐于更新新项目

我一直在使用以下帖子来帮助指导我：

• Search a specific word and copy line to another Sheet

• Copying rows to another worksheet based on a search on a grid of tags

过去两个晚上很有趣，但我觉得我可能比必要的更难。

我能够创建一个 VBA 脚本（从此处的另一篇文章编辑）来扫描所有工作表，但它旨在复制一组列中的所有数据。我测试了它并且它有效。然后，我将用于在 C 列（仅适用于活动表）中识别“打开”或“过期”的代码库合并到代码中。我标记了我的编辑以在这里分享。在这一点上，它不起作用，我走路时头晕目眩。任何关于我在哪里对代码进行 fubar-ed 的提示都将不胜感激。我的代码库是：

Sub SweepSheetsCopyAll()

    Application.ScreenUpdating = False
   'following variables for worksheet loop
    Dim W As Worksheet, r As Single, i As Single
   'added code below for finding the fixed values on the sheet
    Dim lastLine As Long
    Dim findWhat As String
    Dim findWhat1 As String
    Dim findWhat2 As String
    Dim toCopy As Boolean
    Dim cell As Range
    Dim h As Long 'h replaced i variable from other code
    Dim j As Long

    'replace original findWhat value with new fixed value

    findWhat = "Open"
    'findWhat2 = "Past Due"


    i = 4
    For Each W In ThisWorkbook.Worksheets
        If W.Name <> "Summary" Then
           lastLine = ActiveSheet.UsedRange.Rows.Count 'Need to figure out way to loop all rows in a sheet to find last line
            For r = 4 To lastLine 'formerly was "To W.Cells(Rows.Count, 1).End(xlUp).Row"
                'insert below row match search copy function
                For Each cell In Range("B1:L1").Offset(r - 1, 0)
                   If InStr(cell.Text, findWhat) <> 0 Then
                      toCopy = True
                   End If
               Next
            If toCopy = True Then
    ' original code               Rows(r).Copy Destination:=Sheets(2).Rows(j)
     Range(W.Cells(r, 1), W.Cells(r, 12)).Copy _
                        ThisWorkbook.Worksheets("Summary").Cells(i, 1)
                j = j + 1
            End If
            toCopy = False
        'Next

                'end above row match search function
                'below original code that copied everything from whole worksheet
         '       If W.Cells(r, 1) > 0 Then
   '                 Range(W.Cells(r, 1), W.Cells(r, 12)).Copy _
    '                    ThisWorkbook.Worksheets("Summary").Cells(i, 1)
          '          i = i + 1
           '     End If
            Next r
        End If
    Next W
End Sub

扫描所有工作表的工作代码库是：

Sub GetParts()
    Application.ScreenUpdating = False
    Dim W As Worksheet, r As Single, i As Single
    i = 4
    For Each W In ThisWorkbook.Worksheets
        If W.Name <> "Summary" Then
            For r = 4 To W.Cells(Rows.Count, 1).End(xlUp).Row
                If W.Cells(r, 1) > 0 Then
                    Range(W.Cells(r, 1), W.Cells(r, 3)).Copy _
                        ThisWorkbook.Worksheets("Summary").Cells(i, 1)
                    i = i + 1
                End If
            Next r
        End If
    Next W
End Sub

从Activesheet中复制匹配的数据如下：

Sub customcopy()

Application.ScreenUpdating = False
Dim lastLine As Long
Dim findWhat As String
Dim findWhat1 As String
Dim findWhat2 As String
Dim toCopy As Boolean
Dim cell As Range
Dim i As Long
Dim j As Long

'replace original findWhat value with new fixed value

findWhat = "Open"
'findWhat2 = "Past Due"

lastLine = ActiveSheet.UsedRange.Rows.Count 'Need to figure out way to loop through all sheets here

'below code does nice job finding all findWhat and copying over to spreadsheet2
j = 1
For i = 1 To lastLine
    For Each cell In Range("B1:L1").Offset(i - 1, 0)
        If InStr(cell.Text, findWhat) <> 0 Then
            toCopy = True
        End If
    Next
    If toCopy = True Then
        Rows(i).Copy Destination:=Sheets(2).Rows(j)
        j = j + 1
    End If
    toCopy = False
Next

i = MsgBox(((j - 1) & " row(s) were copied!"), vbOKOnly, "Result")

Application.ScreenUpdating = True
End Sub

Answer 1

你应该看看这个Vba macro to copy row from table if value in table meets condition

在您的情况下，您需要创建一个循环，使用此高级过滤器将数据复制到您的目标范围或数组。

如果您需要进一步的建议，请发布您的代码，以及您遇到的问题。