在文件夹中的所有文件中搜索大量字符串

正如我在评论中所写的那样，您可以将您的任务分解为多个较小的任务并按部分进行搜索。

这是上面所说的一个例子 - 你的问题一步一步：
1. 取一个文件夹，里面有文件；
2. 将每个工作簿一一打开；
3.查看打开的工作簿中的每个工作表（涵盖以前任务的链接（2d post））；
4. 查看该工作簿每张纸上的特定范围；
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