Daten aus mehreren Datein zusammenfassen

[KS20]

Hallo liebe Gemeinde,
 
ich habe folgendes Problem und hoffe es gibt dafür eine Lösung!
 
Ich habe in mehreren Ordnern und Unterordnern verschieden Excel-Dateien.
Die Excel-Dateien haben alle einen unterschiedlichen Namen.
Allerdings, das ist das gute, die Daten die ich benötige stehen überall an derselben Stelle, da diese Dateien immer aus ein und derselben Vorlage genommen wurden.
Nun will ich mir eine Tabelle machen, wo ich per Button, bestimmte Daten z.B. Blattname: „2016“ und Zelle „A1“, „B1“ und „D4“ automatisch aus den vielen Excel-Dateien rausziehen kann!
Kurzfassung:
1 Hauptordner, darin viele Unterordner mit Unterordner, darin immer dieselbe Excel-Vorlage, nur anders benannt!
 
Danke für Eure Hilfe!

MfG

[Peter]

Hallo,

schau dir mal diesen Thread an, da solltest du einige Ansätze bekommen:

http://www.clever-excel-forum.de/Thread-...8#pid34798

[Fennek]

Hallo,

versuche mal diesen Code von snb:

Zuerst muss der Basis-Ordner eingegeben werden, dann sollte der Code alle *.xls* in allen Unterordnern auflististen. Wenn dann klappt, kann man nacheinander alle Dateien öffnen und die gesuchten Werte auslesen.

Code:

Sub M_snb_dir()
 sn = Split(CreateObject("wscript.shell").exec("cmd /c dir ""c:\temp\*.xls"" /b/s").stdout.readall, vbCrLf)
 For Each d In sn
   Debug.Print d
 Next d
End Sub

Sieh es ale Test, ob du über die mindest Kenntnisse verfügs.

mfg

[Gast 123]

Hallo

ich verweise höflich auf den Thread vom:  7.8.2016  19:02   Mehrere Exceldatein zu einer zusammenfassen
Darin gibt es eine Beispieldate zum Dateien öffneni:   Dateien Öffnen.xls (Größe: 67 KB / Downloads: 4)
Ich weiss nicht ob man davon was brauchen kann?  Einfach mal unverbindlich ansehen ...

Evtl. kann der vorhandene Code ja umgeschrieben swerden.

mfg  Gast 123

[KS20]

Hallo, danke für eure Hilfe!

Also das Auslesen aus mehreren Excel funktionier super!

Nur habe ich das Problem, dass alle in EINEM Ordner liegen müssen.
mein kleines VBA soll aber auch in den Unterordnern nachsehen!

Danke

So sieht mein Code bis jetzt aus:

Sub suchen()
Dim strPath$, strFile$
Dim iRows&
strPath = "c:\Test\Test\"
strFile = Dir$(strPath & "*.xlsm", vbNormal)
iRows = 1
Do Until Len(strFile) = 0
.
.
.
.
.
.

[Gast 123]

Hi

es gibt einen sehr alten Code den ich einmal im Internet gefunden habe. Ich benutze ihn zum -alle Ordner- auflisten 

Interessant für dich ist der 2. Teil.  Sub Dateisuche(Laufwer, Dateien)  Das interessante ist, er ruft sich im Programm selbst auf, wiederholt sich, bis alle Unterordner durchsucht wurden. Den Teil kannst du ja evtl. für dich umschreiben. Einfach ausprobieren.

mfg  Gast 123

Code:

Dim z, unterordner As Variant

Sub Suchen()
Dim Laufwerk, Dateien As String
z = 2
'Tabellenbereich löschen
[a1:d4000] = ""
Laufwerk = "C:\"
Laufwerk = InputBox("In welchem Ordner wollen Sie suchen:", "Laufwerk & Ordner", "C:\")
If Laufwerk = "" Then Exit Sub
Unterordner = MsgBox("Unterordner mit einbeziehen?", vbYesNo, "Unterordner")
Dateien = "*.*"
Dateien = InputBox("Nach welchen Dateien wollen Sie suchen:", "Dateityp", "*.*")
If Dateien = "" Then Exit Sub
Dateisuche Laufwerk, Dateien
End Sub


Sub Dateisuche(Laufwerk, Dateien)
Dim temp, wdhlg, Dateiname As String
On Error Resume Next
If Right(Laufwerk, 1) <> "\" Then Laufwerk = Laufwerk + "\"
temp = Dir(Laufwerk & Dateien)
Do While Len(temp)
 Dateiname = Laufwerk & temp
 Application.StatusBar = Dateiname
 Cells(z, 1).Select
 Cells(z, 1) = Laufwerk & temp
 Cells(z, 2) = FileLen(Laufwerk & temp)
 Cells(z, 3) = FileDateTime(Laufwerk & temp)
 Cells(z, 4) = temp
 z = z + 1
 temp = Dir()
Loop
temp = Dir(Laufwerk, vbDirectory)
If unterordner = vbNo Then temp=""
Do While Len(temp)
 If (temp <> ".") And (temp <> "..") Then
   If (GetAttr(Laufwerk & temp) And vbDirectory) = vbDirectory Then
     Dateisuche Laufwerk & temp, Dateien
     z = z - 1
     wdhlg = Dir(Laufwerk, vbDirectory)
     z = z + 1
     Do While wdhlg <> temp
       wdhlg = Dir()
     Loop
   End If
 End If
 temp = Dir()
Loop
On Error GoTo 0
Application.StatusBar = False
End Sub

[KS20]

Hallo,

versuche mal diesen Code von snb:

Zuerst muss der Basis-Ordner eingegeben werden, dann sollte der Code alle *.xls* in allen Unterordnern auflististen. Wenn dann klappt, kann man nacheinander alle Dateien öffnen und die gesuchten Werte auslesen.

Code:

Sub M_snb_dir()
 sn = Split(CreateObject("wscript.shell").exec("cmd /c dir ""c:\temp\*.xls"" /b/s").stdout.readall, vbCrLf)
 For Each d In sn
   Debug.Print d
 Next d
End Sub

Sieh es ale Test, ob du über die mindest Kenntnisse verfügs.

mfg

Das habe ich nun mittlerweile angepasst, kommt aber nur eine schwarzes Fenster, welches sich sofort wieder schließt, weiß nicht was ich damit anfangen soll!

[schauan]

Hallo,

das schwarze Fenster braucht Dich nicht zu beunruhigen, das kommt durch den Shell-Befehl. Der Punkt ist aber, dass Dir das Ergebnis im Direktfenster ausgegeben wird - ... Debug.Print ...
Das Direktfenster ist im VBA-Editor standardmäßig nicht geöffnet. Öffne es im VBA-Editor über das Menü| Ansicht | Direktfenster.