在许多工作簿中find特定的关键字以及相应的值，并将其放在一个工作簿的列中

在之前的文章中，我询问了如何突出显示以特定关键词开始的单元格区域，并在下一个单元格为空时结束。 我想更好地了解如何创build一个在多个Excel文件上执行此操作的循环。 任何帮助将非常感激。 作为参考，我所指的代码如下：

Dim wk As Worksheet Set wk = ActiveSheet FirstRowColA = Application.WorksheetFunction.Match("keyphrase", wk.[A:A]) LastRowColA = Cells(wk.Rows.Count, "A").End(xlUp).Row wk.Range("A" & FirstRowColA & ":A" & LastRowColA).Copy Worksheets("Sheet2").Paste 

另外，我很好奇如何处理创build“工作表2”，如果在活动工作簿中不存在的话。 我需要使用像设置WS = Sheets.Add和Excel看看工作表（Sheets.Add）。粘贴？

我也注意到这个代码不一定能find我要找的东西，但这是我应该能够解决的问题。 例如，在Match（）函数中放置“Name”这个短语就会返回列A中一个包含不同单词的单元格的文本。

Answer 1

比方说，你有一些文件夹中的Excel文件

此代码打开文件夹中的每个工作簿，并search特定string（如果find）。复制并粘贴所需的数据。

 Sub LoopThroughFiles() Dim StrFile As String Dim wk As Worksheet StrFile = Dir("C:\Personal\Excel Report\*.xlsx") Do While Len(StrFile) > 0 Workbooks.Open ("C:\Personal\Excel Report\" & StrFile) Set wk = ActiveSheet Set firstrowcola = activesheet.Range("A:A").Find("taskname") ' - search taskname in 1st row If firstrowcola Is Nothing Then GoTo here: LastRowColA = Cells(wk.Rows.Count, "A").End(xlUp).Row wk.Range(firstrowcola.address & ":" & firstrowcola.offset(lastrowcola,0).address)).Copy Set ws = Sheets.Add ws.Range("A1").Select ActiveSheet.Paste here: ActiveWorkbook.Close True Loop End Sub