Sub WerteausDateien_addieren()
' Werte einer Zelle aus allen Dateien
' eines Verzeichnisses addieren und ausgeben
' Quelle: Herbert Taferner
Dim Dateiname As String
Dim Verz As String
Dim dat As String
Dim Blatt As String
Dim Zelle As String
Dim Gesamt As Variant
Dim Wert As Variant
Application.ScreenUpdating = False
Zelle = "A16" 'Hier Zelle angeben
Blatt = "Tabelle1" 'Hier Tabelle angeben
Verz = "C:\Privat\Excel\" 'Hier Verzeichnis angeben
dat = "*.xls" 'Hier Datei angeben
If Right(Verz, 1) <> "\" Then Verz = Verz & "\"
Dateiname = Dir$(Verz & dat)
Do While Dateiname <> ""
Wert = ExecuteExcel4Macro("'" & Verz & "[" & _
Dateiname & "]" & Blatt & "'!" & _
Range(Zelle).Range("A1").Address(, , xlR1C1))
Gesamt = Gesamt + Wert
Dateiname = Dir$()
Loop
Application.ScreenUpdating = True
MsgBox "Summe " & Gesamt
End Sub