VBA copy values from multiple sheets based on multiple criteria into one worksheet

[GEO81]

Dears!

I have managed to modify a VBA code with the following result.
I can have multiple criteria for which my code search to different workbooks and if criteria meets then brings the required values to a new worksheet for each criteria value.
What I want to achieve is to bring all the values to one Worksheet Named Data (Workbook: Macros) .
So the first step is to replace the Row: Set wOut = Worksheets.Add with: Set wOut = Workbooks("Macros.xlsm").Sheets("Data").
However I'm not sure how to continue in order the values from my second criteria not to overwrite the previous ones.

Any assistance is more than welcome!

Sub SearchFolders()

    Dim fso As Object
    Dim fld As Object
    Dim strSearch As String
    Dim strPath As String
    Dim strFile As String
    Dim wOut As Worksheet
    Dim wbk As Workbook
    Dim wks As Worksheet
    Dim lRow As Long
    Dim rFound As Range
    Dim strFirstAddress As String

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False


    strPath = "C:\Users\cmkon\Desktop\CAMS"
    strSearch = InputBox("Enter Criteria")


Dim MyArray() As String, I As Variant


MyArray = Split(strSearch, ";")


For Each I In MyArray
  

    Set wOut = Worksheets.Add
    lRow = 1
    With wOut
        .Cells(lRow, 1) = "Workbook"
        .Cells(lRow, 2) = "Worksheet"
        .Cells(lRow, 3) = "Cell"
        .Cells(lRow, 4) = "Text in Cell"
        .Cells(lRow, 5) = "Instructions"
        .Cells(lRow, 6) = "WS#"
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fld = fso.GetFolder(strPath)


        strFile = Dir(strPath & "\*.xls*") 'here defines which files to check
        Do While strFile <> ""
            Set wbk = Workbooks.Open _
              (Filename:=strPath & "\" & strFile, _
              UpdateLinks:=0, _
              ReadOnly:=True, _
              AddToMRU:=False)


            For Each wks In wbk.Worksheets
            Set rFound = wks.UsedRange.Find(I)
          
                        
                If Not rFound Is Nothing Then
                    strFirstAddress = rFound.Address
                End If
                Do
                    If rFound Is Nothing Then
                        Exit Do
                    Else
                        lRow = lRow + 1
                       .Cells(lRow, 1) = wbk.Name
                        .Cells(lRow, 2) = wks.Name
                        .Cells(lRow, 3) = rFound.Address
                        .Cells(lRow, 4) = rFound.Value
                       .Cells(lRow, 5) = rFound.Offset(, -1).Value
                       .Cells(lRow, 6) = lRow - 1
 
 
                    End If
                    Set rFound = wks.Cells.FindNext(After:=rFound)
                Loop While strFirstAddress <> rFound.Address
            Next


            wbk.Close (False)
            strFile = Dir
        Loop
        .Columns("A:F").EntireColumn.AutoFit
    End With
    

 Next I

MsgBox "Done"

ExitHandler:
    Set wOut = Nothing
    Set wks = Nothing
    Set wbk = Nothing
    Set fld = Nothing
    Set fso = Nothing
    Application.ScreenUpdating = True
    Exit Sub


ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
    
    
End Sub