INDEX MATCH in VBA über mehrere Dateien
05.02.2018 12:01:06
Steffen
ich habe dieses Tabellenblatt: https://www.herber.de/bbs/user/119497.jpg
Unter Broker sind natürlich Namen verborgen, bei Last Update handelt es sich um Daten, bei dem Rest um Zahlen. Ich möchte in die jeweiligen Zellen untereinander die Ergebnisse aus verschiedenen Dateien einpflegen, die immer jeweils im 4. Tabellenblatt der jeweiligen Arbeitsmappe zu finden sind.
Ich habe durch versuchen und lesen verschiedenster Seiten bereits diesen Code erstellt. Leider funktioniert dieser nicht, so wie ich es oben beschrieben habe. Es werden immer Fehlermeldungen angezeigt.
Sub Zusammenfuehren()
Dim oTargetSheet As Object
Dim oSourceBook As Object
Dim sPfad As String
Dim sDatei As String
Dim lErgebnisZeile As Long
Application.ScreenUpdating = False
'Zieldatei festlegen
Set oTargetSheet = ActiveWorkbook.Sheets(1)
lErgebnisZeile = 6 'Ergebnisse eintragen ab Zeile 6
'Schleife über alle Excel Dateien in einem Verzeichnis
sPfad = "\\STUDENTS_SMB\Bannenbe\Desktop\Beispielordner\"
sDatei = Dir(CStr(sPfad & "*.xl*")) 'Alle Excel Dateien
Do While sDatei ""
'öffnen der Datei und Datenübertragung
Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
'Datenübertragung
'Datum
Dim Suchbereich As Range
Dim Zeile As Range
Dim Spalte As Range
Dim x As Variant
Set Suchbereich = oSourceBook.Sheets(4).Range("B5:N13")
SuchkriteriumZeile = oTargetSheet.Cells("C3")
SuchkriteriumSpalte = oTargetSheet.Cells("D5")
Set Zeile = oSourceBook.Sheets(4).Range("B5:B13")
Set Spalte = oSourceBook.Sheets(4).Range("B4:N4")
With Application.WorksheetFunction
oTargetSheet.Cells(lErgebnisZeile, 4).x = .index(Suchbereich, .Match(SuchkriteriumZeile, _
Zeile, 0), .Match(SuchkriteriumSpalte, Spalte, 0), 1)
End With
'Schritt 4: Datei wieder zu machen und nächste Schleifenrunde
oSourceBook.Close False 'nicht speichern
'Nächste Datei
sDatei = Dir()
lErgebnisZeile = lErgebnisZeile + 1 'nächste Zeile auf dem Ergebnisblatt
Loop
Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
'Variablen aufräumen
Set oTargetSheet = Nothing
Set oSourceBook = Nothing
End Sub
Es wäre außerdem genial, wenn vor der Index-"Abfrage" nach einem Wert/Namen überprüft wird, ob die betreffende Zelle überhaupt ausgefüllt ist oder nicht. Da nicht in jedem Arbeitsblatt zu jeder Suche Werte/Namen eingetragen sind. Ich hoffe, dass mein Problem klar wurde.
Vielen Dank im Voraus,
Steffen