Mostrar un valor de la celda, que está al lado de una celda, que contiene un valor ya encontrado (A1, A2)

Question

Quiero actualizar mi búsqueda y quierolFila, celda 5para mostrar el valor después.Celdas(lFila, 4), cual esrEncontrado.Valor.

Intenté con FindNext, pero busca un específicocadena.

Y luegolFila, 6para mostrar el valor, que está en la celda despuéslFila, celda 5etcétera..

Se me acabaron las ideas... ¿Hay alguna salida fácil?

 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.FindNext(rFound.Value) //this is so wrong!
            '.Cells(lRow, 6) = wbk.Name
            '.Cells(lRow, 7) = wbk.Name
            '.Cells(lRow, 8) = wbk.Name

Aquí está el código completo:

Sub SearchFolder()
    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
    Application.Calculation = xlCalculationManual 'added by me

    'Change as desired
    'strPath = "T:\Rali\Excel\Test"
    'strSearch = "hey"
    
    strPath = ActiveSheet.Range("C10")
    strSearch = ActiveSheet.Range("E10")

    Set wOut = Worksheets.Add
    lRow = 1
    With wOut
        .Cells(lRow, 1) = "Workbook's Name"
        .Cells(lRow, 2) = "Worksheet's Name"
        .Cells(lRow, 3) = "Cell Address"
        .Cells(lRow, 4) = "Single - Label"
        .Cells(lRow, 5) = "Short Name"
        .Cells(lRow, 6) = "Last Name"
        .Cells(lRow, 7) = "First Name"
        .Cells(lRow, 8) = "E-Mail"
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fld = fso.GetFolder(strPath)

        strFile = Dir(strPath & "\*.xls*")
        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(strSearch)
                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.FindNext(rFound.Value)
                       '.Cells(lRow, 6) = wbk.Name
                       '.Cells(lRow, 7) = wbk.Name
                       '.Cells(lRow, 8) = wbk.Name
                    End If
                    Set rFound = wks.Cells.FindNext(After:=rFound)
                Loop While strFirstAddress <> rFound.Address
            Next

            wbk.Close (False)
            strFile = Dir
        Loop
        .Columns("A:D").EntireColumn.AutoFit
        End With
 If lRow > 1 Then 'added by me
    MsgBox "Done"
Else
    MsgBox "Nothing found! You are one step closer to approving this credit limit request :)"
End If

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

¡Estaría muy agradecido por tu ayuda! :)

Answer 1

Para pasar a la siguiente celda, puede usar OFFSET, como:

rFound.Offset(1,0)