Excel-Makro Dateien und Tabellenblätter durchsuchen und Werte in neue Excel Datei auslesen

Hallo,

ich würde gerne ein ähnliches Makro wie in Excel Dateien durchsuchen und Werte in neue Excel Datei auslesen verwenden, bekomme aber die Anpassung für meine Zwecke nicht hin.

Ich habe mehrere Dateien mit jeweils mehreren Tabellenblättern, die ausgelesen werden sollen und deren Daten in eine Zieldatei übertragen werden sollen.

Das ganze soll mit einem Suchbegriff geschehen, aber je nach Suchbegriff sollen in Relation zum Suchbegriff unterschiedliche Zellen ausgelesen werden.

Bsp. Suchbegriff Name => +1 Spalte rechts soll ausgegeben werden
Bsp. Suchbegriff Auszahlunt Monatsprämie 1 => +1 Zeile darunter soll ausgegeben werden
Bsp. Suchbegriff Zielerreichung MP 1 => + 1 Spalte rechts soll ausggegeben werden
Bsp. Suchbegriff Jan 11 => + Spalte 1-7 rechts davon sollen ausgegeben werden

D.h. ich muss irgendwie für jeden Suchbegriff definieren können, welcher Wert ausgegeben werden soll, dieser soll dann in der Zieldatei jeweils in die Spalte daneben geschrieben werden und die Daten aus dem nächsten Tabellenblatt in einer neuen Zeile etc.

Ich kenn mich mit Makros nicht so gut aus, ein paar kleinere Anpassungen hab ich zwar geschafft, aber jetzt häng ich.
Anbei mein (fehlerhafter) Versuch:

Sub GetData()

Dim oMe As Object, sBereich As String, iZeile As Integer, iSpalte As Integer, sKennz As String
Dim i As Integer, sWbName As String, rFound As Range
Dim vName As Variant, vVorname As Variant, vBU As Variant, vAbteilung As Variant, vMPK1 As Variant, vMPK2 As Variant, vMPK3 As Variant
Dim oFS As Object, oDatei As Object, wsTabelle As Worksheet, bEintrag As Boolean

Set oMe = ThisWorkbook.Worksheets("Tabelle1") 'Zieltabelle (in der gerade geöffneten Datei)  

iZeile = 4 'ab dieser Zeile Ergebnisse in die Zieltabelle eintragen  
iSpalte = 1

Const sDateiPfad As String = "H:\Eigene Dateien\Dateienauslesen\" 'Pfad für zu durchsuchende Excel-Dateien; mit Backslash am Ende  
Const iSbAnzahl = 7 'Nach x Begriffen suchen  
Dim sSuchbegriff(iSbAnzahl) As String
sSuchbegriff(1) = "Name:"  
sSuchbegriff(2) = "Vorname:"  
sSuchbegriff(3) = "BU:"  
sSuchbegriff(4) = "Abteilung:"  
sSuchbegriff(5) = "Auszahlung Monatspraemie 1"  
sSuchbegriff(6) = "Auszahlung Monatspraemie 2"  
sSuchbegriff(7) = "Auszahlung Monatspraemie 3"  
sBereich = "A1:Z200"  

Set oFS = CreateObject("Scripting.FileSystemObject")  
For Each oDatei In oFS.GetFolder(sDateiPfad).Files
    sWbName = oDatei.Name
    Workbooks.Open (oDatei.Path), Password:="pw", WriteResPassword:="pw"  
    For Each wsTabelle In Workbooks(sWbName).Worksheets()
            For i = 0 To iSbAnzahl
                Set rFound = wsTabelle.Range(sBereich).Find(sSuchbegriff(i), LookIn:=xlValues)
                If Not rFound Is Nothing Then
                    vWert = wsTabelle.Cells(rFound.Row, rFound.Column + 1).Value
                    vVorname = wsTabelle.Cells(rFound.Row, rFound.Column + 1).Value
                    vBU = wsTabelle.Cells(rFound.Row, rFound.Column + 1).Value
                    vAbteilung = wsTabelle.Cells(rFound.Row, rFound.Column + 1).Value
                    vMPK1 = wsTabelle.Cells(rFound.Row + 1, rFound.Column).Value
                    vMPK2 = wsTabelle.Cells(rFound.Row + 1, rFound.Column).Value
                    vMPK3 = wsTabelle.Cells(rFound.Row + 1, rFound.Column).Value
                    With oMe
                    .Cells(iZeile, i + 1).Value = vName
                    .Cells(iZeile, i + 2).Value = vVorname
                    .Cells(iZeile, i + 3).Value = vBU
                    .Cells(iZeile, i + 4).Value = vAbteilung
                    .Cells(iZeile, i + 5).Value = vMPK1
                    .Cells(iZeile, i + 6).Value = vMPK2
                    .Cells(iZeile, i + 7).Value = vMPK3
                    bEintrag = True
                    End With
                End If
            Next
            If bEintrag Then iZeile = iZeile + 1 'mindestens ein Eintrag erfolgt, daher neue Zeile  
    Next
    Workbooks(sWbName).Saved = True
    Workbooks(sWbName).Close
Next
End Sub