Excel VBA: Inhalt einer Zelle suchen und in Relation zu dieser Zelle Werte auslesen

Guten Tag Zusammen

Erstmal vielen Dank an alle für die Hilfe zuvor. Ich konnte innerhalb von 2 Tagen einiges über VBA Lernen.

Nun zu meinem Problem: Ich möchte mehrere Exceldateien nach bestimmten Werten durchsuchen und die Werte aufnehmen.
Momentan funktioniert das auch schon mit festen Zellen, die ich auslese. Ich würde aber lieber den Inhalt (Überschrift) einer Zelle suchen und in Relation (Eine Zeile tiefer bzw. eine Spalte weiter nach rechts) die Inhalte auslesen.

Z.B. In Zelle C29 Steht das Wort "Finding" dies Steht immer in der Spalte C, kann aber in anderen Dokumenten in einer anderen Zeile stehen. (Ich suche ja in mehreren Exceldokumenten)
Von dort aus möchte ich eine Spalte nach rechts und eine Zeile nach unten die nachstehenden Werte auslesen. Z.B. D30-D35. Dabei ist mir besonders wichtig, das sich die durchsuchten Exceltabellen auf keinen Fall verändern oder Beeinträchtigt werden.

Vielen Dank im Voraus für eure Hilfen.

Nachgetragen möchte ich den bisher erstellten Code für alle veröffentlichen. Ich denke durch die Kommentare können auch andere etwas aus dem Code lernen. Falls Fehler im Code sind, freue ich mich auch über Rückmeldungen; immerhin bin ich absoluter Anfänger in VBA.

Schöne Grüße

Option Explicit
Option Compare Text
'
' Verzeichnisse inklusive Unterverzeichnisse nach "*Beispiel*.xlsx" Dateien suchen, Auflisten und bestimmte Zellen auslesen
'

Dim sRootPath As String
Private lRowCounter As Long
Private oSheet As Object

'Start der Routine: Call DateienMitUnterordnernAuslesen
Public Sub DateienMitUnterordnernAuslesen()
Set oSheet = Sheets.Add 'Neues Sheet erstellen
oSheet.Activate 'Neues Sheet aktivieren
oSheet.Cells(1, 1).Select 'Zelle Oben Links wählen
Call CreateHeadLinesAndFormat 'Erstelle und formatiere die Headlines
lRowCounter = 2 'Beginne in Zeile zwei mit der Aufnahme von Daten
sRootPath = InputBox("Pfad eingeben", "sRootPath") 'Inputbox zur Pfadeingabe
Call ReadSubFolder(sRootPath) 'Durchsuche die (Unter-)Verzeichnisse nach Dateien und entnehme die Werte
Set oSheet = Nothing 'oSheet leeren/schließen
End Sub

'Formatiere die Headlines
Private Sub CreateHeadLinesAndFormat()
Dim i As Long

oSheet.Cells(1, 1) = "Pfad" 'Setze die Spalte Pfad
oSheet.Cells(1, 2) = "Dateiname" 'Setze die Spalte Dateiname
oSheet.Cells(1, 3) = "FS" 'Setze die Spalte FS
oSheet.Cells(1, 4) = "F" 'Setze die Spalte F
oSheet.Cells(1, 5) = "C" 'Setze die Spalte C
oSheet.Cells(1, 6) = "E" 'Setze die Spalte E
oSheet.Cells(1, 7) = "SQA" 'Setze die Spalte SQA
oSheet.Cells(1, 8) = "I" 'Setze die Spalte I
oSheet.Columns(1).ColumnWidth = 40 'Setze die Spaltenbreite auf 40
oSheet.Columns(2).ColumnWidth = 40 'Setze die Spaltenbreite auf 40

For i = 1 To 2 'Formatiere die ersten beiden Headlines ("Pfad" und "Dateiname")
With oSheet
.Cells(1, i).Interior.ColorIndex = 11 'Formatiere die Zellenfarbe
.Cells(1, i).Font.Color = vbWhite 'Formatiere die Textfarbe
.Cells(1, i).Font.Bold = True 'Formatiere die Schriftart
End With
Next i
End Sub

'Suche in den (Unter-)Verzeichnissen nach Dateien im Format "*Beispiel*.xlsx"
Private Sub ReadSubFolder(ByVal sFolderPath As String)
Dim oFSO As Object
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object
Dim sPath As String
Dim sContent As String
Dim sTab As String
Dim sFile As String
Dim sCell As String

Set oFSO = CreateObject("Scripting.FileSystemObject") 'erstelle das FileSystemObject
Set oFolder = oFSO.getfolder(sFolderPath) 'Momentaner Pfad/Path

With oSheet 'Nur auf oSheet arbeiten!

For Each oSubFolder In oFolder.subfolders 'Fuer jedes Verzeichnis

'Alle Dateien auflisten
For Each oFile In oSubFolder.Files 'Solange Dateien vorhanden sind
If oFile Like "*Review*.xlsx" Then 'und die Dateien dem Format entsprechen
.Cells(lRowCounter, 1) = oSubFolder.Path 'werden Pfad und
.Cells(lRowCounter, 2) = oFile.Name 'Dateiname ins ExcelTab geschrieben
sPath = oSubFolder.Path 'Danach wird der Pfad,
sFile = oFile.Name 'Dateiname
sTab = "Cover" 'und der Reitername
sCell = "D30" 'der Zelle gewählt

' Eintragen in Zelle
sContent = GetValue(sPath, sFile, sTab, sCell) 'Entsprechende Zelle wird ausgelesen
.Cells(lRowCounter, 3) = sContent 'und in ExcelDokument eingetragen

' Eintragen in Zelle
sCell = "D31" 'Zelle wählen
sContent = GetValue(sPath, sFile, sTab, sCell) 'Entsprechende Zelle wird ausgelesen
.Cells(lRowCounter, 4) = sContent 'und in ExcelDokument eingetragen

' Eintragen in Zelle
sCell = "D32" 'Zelle wählen
sContent = GetValue(sPath, sFile, sTab, sCell) 'Entsprechende Zelle wird ausgelesen
.Cells(lRowCounter, 5) = sContent 'und in ExcelDokument eingetragen

' Eintragen in Zelle
sCell = "D33" 'Zelle wählen
sContent = GetValue(sPath, sFile, sTab, sCell) 'Entsprechende Zelle wird ausgelesen
.Cells(lRowCounter, 6) = sContent 'und in ExcelDokument eingetragen

' Eintragen in Zelle
sCell = "D34" 'Zelle wählen
sContent = GetValue(sPath, sFile, sTab, sCell) 'Entsprechende Zelle wird ausgelesen
.Cells(lRowCounter, 7) = sContent 'und in ExcelDokument eingetragen

' Eintragen in Zelle
sCell = "D35" 'Zelle wählen
sContent = GetValue(sPath, sFile, sTab, sCell) 'Entsprechende Zelle wird ausgelesen
.Cells(lRowCounter, 8) = sContent 'und in ExcelDokument eingetragen


lRowCounter = lRowCounter + 1 'Zeile für nächsten Durchlauf setzen
End If
Next oFile 'Nächste Datei wählen

'Alle Unterverzeichnisse verarbeiten (rekursiv)
Call ReadSubFolder(oSubFolder.Path) 'nächstes Verzeichnis durchgehen

Next oSubFolder 'Nächstes Verzeichnis

End With 'Ende der Bearbeitung von oSheet

Set oFSO = Nothing 'Alles zurücksetzen bzw. schließen
Set oFile = Nothing 'Alles zurücksetzen bzw. schließen
Set oFolder = Nothing 'Alles zurücksetzen bzw. schließen
Set oSubFolder = Nothing 'Alles zurücksetzen bzw. schließen
End Sub

'Daten aus geschlossener Arbeitsmappe auslesen
Private Function GetValue(sPath, sFile, sTab, sCell)
Dim arg As String

If Right(sPath, 1) <> "\" Then sPath = sPath & "\" 'Sicherstellen, dass der Pfad vorhanden und gesetzt ist
If Dir(sPath & sFile) = "" Then 'Sicherstellen, dass eine datei vorhanden ist
GetValue = "File Not Found" 'Wenn nicht, dann "File Not Fonud" Ausgeben
Exit Function
End If

'Das Argument erstellen
arg = "'" & sPath & "[" & sFile & "]" & sTab & "'!" & Range(sCell).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg) 'Auslesen über Excel4Macro

End Function

Option Explicit

Sub SuchenVBA()
Dim rngAdresse As Range
Dim strKeyword As String
Dim varData 'as Variant  

strKeyword = "Finding"  
Set rngAdresse = ActiveWorkbook.ActiveSheet.UsedRange.Find(strKeyword, LookIn:=xlValues, Lookat:=xlPart)

If Not rngAdresse Is Nothing Then
    varData = Cells(rngAdresse.Row + 1, rngAdresse.Column + 1).Value
    MsgBox "... steht der Wert " & varData, , "rechts unterhalb von Zelle " & rngAdresse.Address & " ..."  
End If
End Sub

dim result as Range
set result = oSheet.Range("C:C").Find("Finding",LookIn:=xlValues)  
if not result is nothing then
    msgbox result.Offset(1,1).Value
else
    msgbox "Nix gefunden"  
End if

With GetObject("D:\datei.xlsx").Sheets("TabelleXYZ")  
    dim result as Range
    set result = .Range("C:C").Find("Finding",LookIn:=xlValues)  
    if not result is nothing then
        msgbox result.Offset(1,1).Value
     else
         msgbox "Nix gefunden"  
    End if
    .Parent.Close False
End with