Werte aus Dateien sammeln
Ausgangslage - Was tut dieser Code-Schnipsel?
Ein immer wieder beliebtes Thema: Zusammenführen von Werten aus mehreren anderen Arbeitsmappen / Dateien. Hierzu habe ich ein kleines Beispiel geschrieben. Einfach entsprechend anpassen und schon haben Sie eine Automatisierung Ihres Sammelvorganges realisiert.
Ergebnisse statt Aufwand & Arbeit?
Wir liefern Ergebnisse - Schicken Sie uns kurz Ihre Datei und Ihre Wünsche; wir integrieren den notwendigen Code professionell, beheben ggf. vorhandene Fehler, machen optional ein Code-Review, liefern bei Bedarf Performance-Optimierungen & setzen gewünschte Erweiterungen effizient für Sie um (und das zum Festpreis nach kurzer Sichtung).
Express-Service beauftragen
Der Quelltext
Option Explicit
' Original-Quelltext unter: https://www.online-vba.de/werte-aus-dateien-sammeln
' Express-Hilfe für VBA unter https://www.online-vba.de/vba-expresshilfe
' Es gelten die Nutzungsbedingungen von Online-VBA.de
Public Sub OVBAde_DatenAusMehrerenDateienEinlesen()
Dim oTargetSheet As Object
Dim oSourceBook As Object
Dim sPfad As String
Dim sDatei As String
Dim lErgebnisZeile As Long
Application.ScreenUpdating = False 'Das "Flackern" ausstellen
'Schritt 1: Neues Arbeitsblatt für die Ergebnisse erstellen
Set oTargetSheet = ActiveWorkbook.Sheets.Add
lErgebnisZeile = 2 'Ergebnisse eintragen ab Zeile 2
'Schritt 2: Schleife über alle Excel Dateien in einem Verzeichnis
sPfad = "C:\TEST\Sammlung\"
sDatei = Dir(CStr(sPfad & "*.xl*")) 'Alle Excel Dateien
Do While sDatei <> ""
'Schritt 3: öffnen der Datei und Datenübertragung
Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
'Datenübertragung
'Spalte 1 - Dateinamen
oTargetSheet.Cells(lErgebnisZeile, 1).Value = sDatei
'Spalte 2 - Zelleninhalt A1 vom Arbeitsblatt "Tabelle1"
oTargetSheet.Cells(lErgebnisZeile, 2).Value = _
oSourceBook.Sheets("Tabelle1").Cells(1, 1).Value
'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
Das könnte Sie auch interessieren:
Unser VBA-Service deckt Erweiterung, Wartung und Qualitätssicherung ab. Wir unterstützen mit Excel-Automatisierung für Berlin – robust und wartbar.
Anmerkungen und Hinweise
Dieser Codeschnipsel wurde geschrieben von Marc Wershoven im Jahr 2013.
Die Nutzung erfolgt auf eigene Gefahr.
Bitte denken Sie immer zuerst an eine ausreichende Datensicherung.
Wir können keinen kostenlosen Support anbieten.
Es gelten unsere Nutzungsbedingungen.
