Поиск всех файлов в папке для многочисленных строк

Question

У меня есть папка с защищенными паролем рабочими книгами (один и тот же пароль) для всех филиалов нашей компании, Ливерпуль, Манчестер и др. c.

В каждой книге есть простая таблица с данными о продажах, номер продажи, имя, адрес электронной почты, инвентарный код и т. д. c, иногда по 3 рабочих листа в каждой рабочей книге

У меня есть основная рабочая книга со списком биржевых кодов.

Мне нужно иметь возможность создать макрос, который просматривает все книги в строке F, и если он находит совпадающее значение для любого из биржевых кодов, скопируйте эту строку и вставьте ее на новый лист в основной книге с заголовком рабочий лист с тем же именем, что и имя файла, в котором он находился, со строками данных повсюду.

У меня было что-то похожее, который искал одну ключевую фразу и возвращал строку, но мне нужно, чтобы он искал любая строка из целого ряда строк.

Sub STBP()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWS As Worksheet, wkbSource As Workbook, response As String, LastRow As Long
    Set desWS = ThisWorkbook.Sheets("Sales to be Processed")
    response = InputBox("Please enter the search string.")
    If response = "" Then Exit Sub
    Const strPath As String = "C:\Users\marc.delaney\Documents\TestSave\" 'change folder path to suit your needs
    ChDir strPath
    strExtension = Dir(strPath & "*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            LastRow = desWS.Range("C" & Rows.Count).End(xlUp).Row
            Set srcWS = .Sheets("Sales To Be Processed")
            srcWS.Unprotect Password:="cgeod18"
            With srcWS.Cells(7, 2).CurrentRegion
                .AutoFilter Field:=12, Criteria1:="=*" & response & "*"
                desWS.Range("A" & LastRow + 1) = wkbSource.Name
                srcWS.AutoFilter.Range.Offset(1, 0).Copy desWS.Cells(desWS.Rows.Count, "B").End(xlUp).Offset(1, 0)
            End With
            .Close SaveChanges:=False
        End With
        strExtension = Dir
    Loop
    Columns.AutoFit
    Application.ScreenUpdating = True
 End Sub

Answer 1

Как я уже писал в комментарии, вы могли бы разбить вашу задачу на несколько меньших и искать по частям.

Вот пример из сказанного выше - ваш вопрос шаг за шагом:
1. Возьмите папку с файлами;
2. Откройте каждую книгу одну за другой;
3. Посмотрите на каждый лист в открытой книге (ссылка , которая охватывает предыдущие задачи (2-й пост) );
4. Просмотрите определенный диапазон c на каждом листе этой книги;
5. Скопируйте строка, если поиск соответствует.

Вот мой ответ. Я пытался объяснить каждый шаг в комментариях, но в случае, если что-то остается неясным - спросите в комментарии.
Некоторые примечания перед кодом (у всех есть комментарии в коде):
- может быть проблема с новым листов в именах основной рабочей книги
- вы сами решаете, хотите ли вы использовать один целевой лист на одну исходную рабочую таблицу или на одну исходную рабочую книгу

код (может показаться слишком длинным и сложным, но это в основном из-за комментариев):

Sub STBP()
Dim FileItem As Object
Dim oFolder As Object
Dim FSO As Object
Dim BrowseFolder As String

Dim checkRange As Range, r As Range ' check range and a variable for loop through it

Dim masterBook As Workbook  ' a master workbook
Dim sourceBook As Workbook  ' a source workbook
Dim sht As Worksheet        ' variable to loop through sheets
Dim targetSheet As Worksheet    ' sheet to copy found data to

Dim searchPattern As String    ' a string for search

' get the stockcode and check that it is entered
searchPattern = Application.InputBox(prompt:="Please enter the search string.", Title:="Enter the stockcode", Type:=2)
If searchPattern = "" Then Exit Sub

' refactor search pattern
searchPattern = "*" & searchPattern & "*"


' if the code is entered - start using memory for needed stuff
Set masterBook = ThisWorkbook
Set FSO = CreateObject("Scripting.FileSystemObject")

    ' get the folder with File Dialog - don't need to hard code that
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select the folder with source files"
        If Not .Show = 0 Then
            BrowseFolder = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

' switch off screen blinking
Application.ScreenUpdating = False

Set oFolder = FSO.GetFolder(BrowseFolder)

' loop through each file in folder
For Each FileItem In oFolder.Files
    ' if this is an excel file
    If FileItem.Name Like "*.xls*" Then
        ' open it for processing
        Set sourceBook = Workbooks.Open(BrowseFolder & Application.PathSeparator & FileItem.Name)

        ' loop through each sheet
        For Each sht In sourceBook.Sheets
            ' unprotect sheet and set a search range (column "F")
            With sht
                .Unprotect Password:="cgeod18"
                Set checkRange = Range(.Cells(1, 6), .Cells(Rows.Count, 6).End(xlUp))
            End With

            ' loop through each cell in column "F"
            For Each r In checkRange
                ' check whether cell value contains the pattern
                If r.Text Like searchPattern Then
                    ' create new sheet in master workbook if there is a match
                    ' and a new target sheet for this workbook is not created yet
                    If targetSheet Is Nothing Then
                        Set targetSheet = masterBook.Sheets.Add(after:=masterBook.Sheets(masterBook.Sheets.Count))
                        ' rename target sheet to "Workbook_name-Sheet_name" to avoid same sheets naming
                        targetSheet.Name = FileItem.Name & "-" & sht.Name
                    End If

                    ' copy data
                    ' check whether first row has data
                    If targetSheet.Cells(Rows.Count, 1).End(xlUp).Row = 1 And targetSheet.Cells(Rows.Count, 1).End(xlUp).Value = "" Then
                        r.EntireRow.Copy Destination:=targetSheet.Cells(1, 1)
                    Else
                        r.EntireRow.Copy Destination:=targetSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                    End If
                End If
            Next
            ' protect the sheet back
            sht.Protect Password:="cgeod18"

            ' use one target sheet per one source sheet
            ' uncomment next line if this is what you need and remove same line below
            'Set targetSheet = Nothing
        Next
        ' close the source workbook
        sourceBook.Close SaveChanges:=False
    End If

    ' use one target sheet per one source workbook
    ' remove this line if you'd like to use one target sheet per one source sheet
    Set targetSheet = Nothing
Next

' set screen updating to normal state
Application.ScreenUpdating = True
End Sub