AW: mehrere Excel-Dateien zusammenfügen
12.07.2017 11:06:53
Tino
Hallo,
kannst mal so testen.
Tabellenname der in den externen Dateien verwendet wird anpassen
Pfad wo diese liegen anpassen
Ausgabe Tabelle anpassen
Sub Test()
Dim ArFiles(), ArAusgabe(), sPath$, sDir$, n&
Dim ExTabellenName$
'Name der Tabelle in der externen Datei
ExTabellenName = "Tabelle1"
'Pfad zum Ordner
sPath = "C:\Ordner\Ordner\"
ChDrive sPath
ChDir sPath
sDir = Dir(sPath & "*.xls?", vbNormal)
Do While sDir <> ""
n = n + 1
Redim Preserve ArFiles(1 To n)
ArFiles(n) = sDir
sDir = Dir$()
Loop
If n > 0 Then
Redim ArAusgabe(1 To Ubound(ArFiles), 1 To 3)
For n = Lbound(ArFiles) To Ubound(ArFiles)
'Datei-Name
ArAusgabe(n, 1) = ArFiles(n)
'Zelle D5
ArAusgabe(n, 2) = "='" & sPath & "[" & ArAusgabe(n, 1) & "]" & ExTabellenName & "'!R5C4"
' Zelle D13
ArAusgabe(n, 3) = "='" & sPath & "[" & ArAusgabe(n, 1) & "]" & ExTabellenName & "'!R13C4"
Next n
With Tabelle1 'Ausgabe Tabelle
'alte Daten löschen ab A2
.Range("A2", .Cells(.Rows.Count, 1)).EntireRow.Delete
'Ausgabe ab A2
With .Range("A2").Resize(Ubound(ArAusgabe), Ubound(ArAusgabe, 2))
.FormulaR1C1 = ArAusgabe 'Formel einfügen
.Value = .Value 'nur Werte
.EntireColumn.AutoFit 'Spaltenbreite einstellen
End With
End With
End If
End Sub
Gruß Tino