WVERWEIS mit Bezug auf mehrere dynamische, externe Dateien

[paul.david2]

Hallo Zusammen,
 
ich habe eine Tabelle, in der für jeden Mitarbeiter (Spalte B3:B14) und Monat (Zeile C2:Z2) erfasst werden soll, wieviel Stunden derjenige gearbeitet hat.
Nun sollen die entsprechenden Werte aus einzelnen Dateien gezogen werden. Der Dateiname ist immer gleich: Info_“Name“ („Name“ entsprechend dem Wert in Spalte B).
Auch der Aufbau in den Dateien, aus denen die Werte ausgelesen werden sollen, ist immer gleich. In Spalte E4:E14 stehen die Monate (Jan-Dez) rechts daneben in Spalte F3:F14 die entsprechenden auszulesenden Werte.
 
Es gibt also zwei Herausforderungen:
1.      Die Werte aus verschiedenen Dateien mit dynamischen Dateinamen auslesen
2.      Die Suchkriterien in der Zieldatei sind horizontal angeordnet (Zeile C2:Z2), in den auszulesenden Dateien jedoch vertikal (E4:E14 bzw. F3:F14).

Ich habe bereits einen SVERWEIS mit Bezug auf Dateien mit dynamischen Dateinamen hinbekommen, jedoch gelingt es mir bisher nicht es entsprechend umzuschreiben :( 
unten seht ihr den alten Code)

Vielen Dank vorab für eure Unterstützung!

Paul


Sub LookupValues()
   
    Dim r As Range
    Dim wbLookup As Workbook, wbDestiny As Workbook
    Dim searchRange As Range
    Dim searchValue As Variant
    Dim sPfadQuelle As String, sDatei As String
    Dim varWert
   
    Application.ScreenUpdating = False
    sPfadQuelle = "C:\Users\xxx\Desktop\Test\"      'Pfad ggf. anpassn
    On Error GoTo Errhandler
   
    Set wbDestiny = ThisWorkbook ' Workbooks("Paul.xlsm") 'HIER NAME DER ZIELDATEI ENTSPRECHEND  _
 _
 _
ÄNDERN
   
    'HINWEIS QUELLDATEIEN R DURCHSCHLEIFEN
    For Each r In wbDestiny.Sheets("A").Range("D3:D21").Cells 'Blattname ggf anpassen
        If r.Text = "Projekt" Then
            r.Offset(0, 4).Value = "" '??? ggf. Zeile weglasen
        Else
            sDatei = sPfadQuelle & "Info_" & r.Text & ".xlsx" 'HIER Syntaxt für Dateiname ggf.   _
 _
_
ANPASSEN
            If Dir(sDatei) = "" Then
                MsgBox "Datei """ & sDatei & """ niht gefunden"
            Else
                searchValue = r.Offset(0, -3).Value
                Set wbLookup = Workbooks.Open(sDatei, ReadOnly:=True)
                Set searchRange = wbLookup.Sheets(1).Range("A4:C27")
               
                varWert = Application.VLookup(searchValue, searchRange, 3, False)
                If IsError(varWert) Then
                    r.Offset(0, 4).Value = "#NV!"
                Else
                    r.Offset(0, 4).Value = varWert
                End If
                wbLookup.Close savechanges:=False
            End If
        End If
    Next r
   
    GoTo Beenden
Errhandler:
   
    MsgBox Err.Description, vbCritical
 
Beenden:
    Application.ScreenUpdating = True
   
End Sub

[schauan]

Hallöchen,

wenn ich nur wüsste, wo genau das Problem liegt

aus VLOOKUP wird HLOOKUP

aus A4:C27 wird vermutlich C2:Z14, wobei eventuell E2:F14 reicht wenn wirklich nur diese beiden Spalten betroffen sind
(Da reicht eventuell auch statt des HLOOKUP eine Fallunterscheidung)

was in r.Offset(0, -3).Value steht, seh ich nicht

…