Werte aus mehreren Dateien konsolidieren

Computer: Software & Programmierung Visual Basic
#1

Auch wenn es dazu schon zig Einträge gibt,
die Lösung meines Problems habe ich noch nicht gefunden.

Hier meine Problembeschreibung:
In Spalte B stehen untereinander verschiedene Dateinamen, die ich zuvor ausgelesen habe.
(Alle sind in einem Ordner, der Aufbau der Dateien ist identisch, nur die enthaltenen Daten variieren.)

Nun möchte ich in Spalte C eine Zelle aus den jeweiligen Dateien auslesen.
Also, in C4 soll z.B. das Datum stehen was in der in B4 genannten Datei in Zelle D21 steht.
In C5 soll das Datum stehen was in der Datei mit dem Namen der in B5 angegeben ist in Zelle D21 steht…

So habe ich noch die verschiedensten Werte in anderen Spalten die ich aus den einzelnen Dateien lesen will.

Nochmal zu Verdeutlichung: Je Spalte suche ich immer den Wert aus der gleichen Zelle, aber aus unterschiedlichen Dateien.

Bisher habe ich noch keine Lösung gefunden, kann vielleicht jemand helfen?

#2

In Spalte B stehen untereinander verschiedene Dateinamen, die
ich zuvor ausgelesen habe.
(Alle sind in einem Ordner, der Aufbau der Dateien ist
identisch, nur die enthaltenen Daten variieren.)

Nun möchte ich in Spalte C eine Zelle aus den jeweiligen
Dateien auslesen.
Also, in C4 soll z.B. das Datum stehen was in der in B4
genannten Datei in Zelle D21 steht.
In C5 soll das Datum stehen was in der Datei mit dem Namen der
in B5 angegeben ist in Zelle D21 steht…

Hi Kristin,

in ein Standardmodul:

Sub Auslesen()
Dim Zei As Long
Application.ScreenUpdating = False
On Error GoTo Fehler
Const Pfad As String = "C:\Meine Daten\"
With ThisWorkbook.ActiveSheet
 For Zei = 2 To .Range("B" & Rows.Count).End(xlUp).Row
 Workbooks.Open Pfad & .Cells(Zei, 2)
 .Range("C" & Zei).Value = ActiveWorkbook.Worksheets(1).Range("D21")
 .Range("D" & Zei).Value = ActiveWorkbook.Worksheets(1).Range("E65")
 .Range("E" & Zei).Value = ActiveWorkbook.Worksheets(1).Range("G12")
 Workbooks(Pfad & .Cells(Zei, 2)).Close savechanges:=False
 Next Zei
End With
Fehler:
Application.ScreenUpdating = True
If Err.Number 0 Then MsgBox "Fehler aufgetreten"
End Sub

Gruß
Reinhard