Finding a specific keyword in many workbooks along

Question

In a previous posting I asked about how to highlight a cell range that began with a certain keyphrase and ended when the next cell was blank. I would like to gain a better understanding of how to create a loop that performs this on multiple Excel files. Any help would be much appreciated. For reference, the code I am referring to is as follows:

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

In addition, I was curious about how to handle creating a "Sheet 2" if one does not exist already in the active workbook. Do I need to use something like Set WS = Sheets.Add and have Excel look at Worksheets(Sheets.Add).Paste?

I have also noticed that this code does not necessarily find what I am telling it to find, but this is an issue I should be able to resolve. For example, putting the phrase "Name" in the Match() function returns the text of a cell in column A containing a different word.

Answer 1

Let say u have excel files in the some folder

this code opens each workbook in the folder and searches specific string if found .copy and paste the required data.

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