Summe mehrerer Exceldateien in einer "Hauptdatei"

Question

Hallo Zusammen,

ich habe mehrere Exceldateien, die alle den gleichen Aufbau haben. Diese befinden sich alle in einem Ordner.
Diese enthalten mehrere Zellen, die ich in einer "Hauptdatei" , die ebenfalls den gleichen Aufbau hat, zusammenfassen möchte. (Zelle F18; F20; F24; F30)

Da mehrere Personen auf diesen Ordner Zugriff haben und immer wieder neue "Einzeldateien" erstellen, sollte die Aufsummierung möglichst automatisch, via Makros erfolgen. Sprich damit ich die Formel nicht ständig erweitern muss...


Kann mir da jemand weiterhelfen?

VG Kati

Answer 1

Hallo Kati,

das folgende Makro gehört in ein Standard-Modul deiner Hauptdatei. Diese Hauptdatei muss im selben Ordner liegen, wie die Einzeldateien. In den Einzeldateien werden die Daten immer aus dem ersten Arbeitsblatt gelesen. Die Daten werden in die Tabelle der Hauptdatei eingefügt, aus der das Makro gestartet wird.

Sub dateien_auslesen()

Dim strPfad As String
Dim strDateiname As String
Dim lngZaehler As Long

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Pfad der Arbeitsmappe in Variable schreiben
strPfad = ThisWorkbook.Path & "\"

'Inhalt des aktiven Blattes in dieser Arbeitsmappe löschen
ThisWorkbook.ActiveSheet.UsedRange.ClearContents

'alle Dateien in Verzeichnis durchlaufen
strDateiname = Dir(strPfad & "*.xlsx")

Do While strDateiname <> ""
If ThisWorkbook.Name <> strDateiname Then
'Arbeitsmappe nur dann öffnen, wenn diese nicht mit dieser Arbeitsmappe identisch ist
Workbooks.Open Filename:=strPfad & strDateiname
'Zähler für Zeilen erhöhen
lngZaehler = lngZaehler + 1
'Daten kopieren
ThisWorkbook.ActiveSheet.Cells(lngZaehler, 1) = strDateiname
ThisWorkbook.ActiveSheet.Cells(lngZaehler, 2) = Workbooks(strDateiname).Worksheets(1).Range("F18")
ThisWorkbook.ActiveSheet.Cells(lngZaehler, 3) = Workbooks(strDateiname).Worksheets(1).Range("F20")
ThisWorkbook.ActiveSheet.Cells(lngZaehler, 4) = Workbooks(strDateiname).Worksheets(1).Range("F24")
ThisWorkbook.ActiveSheet.Cells(lngZaehler, 5) = Workbooks(strDateiname).Worksheets(1).Range("F30")
'Summenformel einfügen
ThisWorkbook.ActiveSheet.Cells(lngZaehler, 6).FormulaLocal = "=Summe(" & Cells(lngZaehler, 2).Address & ":" & Cells(lngZaehler, 5).Address & ")"
'geöffnete Arbeitsmappe ohne Speichern von Änderungen schließen
Workbooks(strDateiname).Close SaveChanges:=False
End If
strDateiname = Dir
Loop

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

Gruß
M.O.