ca 2000 Excel Dateien in einer zusammenfassen

Question

Hallo Community.
Das Problem von Martin betrifft nun auch mich. Deshalb habe ich mich gefreut, den Code von Karin hier gefunden zu haben. Allerdings bricht das Makro immer an der Stelle . new search ab, mit der Fehlermeldung 'Laufzeitfehler 445' : Objekt unterstützt diese Aktion nicht.
Kann dies mit der verwendeten Excel-Variante in Verbindung stehen? Ich verwende Excel 2010. Wie müsste das für ein "VBA-greenhorn" das script ggf. angepaßt werden?
Vielen Dank für Eure Unterstützung! LG Thomas

Answer 1

Hallo Thomas,

du solltest schon angeben, um welchen Code es konkret geht. -> Klick

"Application.FileSearch" gibt es seit Excel 2007 nicht mehr. -> Klick

Gruß
Kalle

Answer 2

Hallo Kalle,
vielen Dank erst einmal für die rasche Antwort.
LG
Thomas

Answer 3

Hallo Kalle,

du hast genau den Beitrag gefunden, der mein Problem beschreibt.
Schade, daß es sich nicht mehr mit diesem code umsetzen läßt, denn diesen hätte ich für meine Bedürfnisse noch anpassen können. Dies gelingt mir mangels VBA-KnowHow mit deinem link-Tipp leider nicht.
Ist es dir möglich, den damaligen code von Karin auf Excel 2010 zu modifizieren? Ich würde mich sehr freuen!

LG
Thomas

Answer 4

Hallo Nick

hier mal eine kleine Starthilfe:

Sub test()

'Mit diesem Makro wird in die erste Spalte der Dateiname und in die zweite Spalte
'der Wert aus Zelle F2 des Blattes Tabelle1 geschrieben

Pfad = "T:\V_Schönig\Rechnungen\"

Set fs = CreateObject("Scripting.FileSystemObject")
Set fd = fs.getfolder(Pfad)
Set fls = fd.Files

For Each fl In fls
i = i + 1
Datei = fl.Name
Cells(i, 1) = Datei
Cells(i, 2).Formula = "='" & Pfad & "[" & Datei & "]" & "Tabelle1" & "'!" & "F2"

Next fl

End Sub

Nach diesem Prinzip kannst weitere Spalten und Felder hinzufügen für die dritte Spalte z.b: Cells(i,3).Formula = ...

Vorraussetzung ist, dass die gewünschten Blätter der Dateien alle den gleichen Name haben. Sonst müsstest du über Workbook open gehen und diesen mit Sheets(1) auslesen.

Gruß Mr. K

Answer 5

Wichtig ist übrigens auch das letzte Zeichen in Pfad. Das muss (wie oben gezeigt) ein umgekehrter Schrägstrich sein.

Answer 6

hi all ^^

kurz genug ?

leicht verstaendlich ?

gruss nighty

kopiert die werte des definierten Bereiches
von allen gefundenen Dateien des angegebenen ordners

Option Explicit
Sub DateienLesen()
Call EventsOff
Dim DateiName As String
DateiName = Dir("D:\Temp\" & "*.xls")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="D:\Temp\" & DateiName
Workbooks(DateiName).Worksheets(1).Range("A1:A" & Workbooks(DateiName).Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlValues, Operation:=xlNone
Workbooks(DateiName).Close SaveChanges:=True
End If
DateiName = Dir
Loop
Call EventsOn
End Sub
Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Answer 7

Hallo ExcelKing,

danke für die Starthilfe.
Obwohl ich Pfad und Adresse nach deinem Beispiel eingegeben habe, bin ich leider nochj nicht zum Ziel gekommen.
Ab Schritt Formula erscheint: Fehler beim Kompillieren - Syntaxfehler ... (Siehe unten)

LG
Thomas

Sub test()

Pfad = "B:\Profil\Desktop\Test\Testdateien"

Set fs = CreateObject("Scripting.FileSystemObject")
Set fd = fs.getfolder(Pfad)
Set fls = fd.Files

For Each fl In fls
i = i + 1
Datei = fl.Name
Cells(i, 1) = Datei
Cells(i, 2).Formula = "='" & B:\Profil\Desktop\Test\Testdateien & "[" & Datei1.xls & "]" & "Preise" & "'!" & "C12"

Next fl

End Sub

Answer 8

Hallo,

in deiner Variable Pfad fehlt der letzte Backslash und in deiner Formel fehlen Anführungszeichen bzw. sind falsch gesetzt.
Hier das Makro, so wie ich es verstehe:

Sub test()

Dim Pfad As String

Pfad = "B:\Profil\Desktop\Test\Testdateien\"

Set fs = CreateObject("Scripting.FileSystemObject")
Set fd = fs.getfolder(Pfad)
Set fls = fd.Files

For Each fl In fls
i = i + 1
Datei = fl.Name
Cells(i, 1) = Datei
Cells(i, 2).Formula = "='" & Pfad & "[" & Datei & "]Preise'!C12"

Next fl

End Sub

Der Pfad nach deiner Angabe wäre wie folgt richtig:

Cells(i, 2).Formula = "='B:\Profil\Desktop\Test\Testdateien\[" & Datei & "]Preise!'C12"

Gruß

M.O.

Answer 9

Hallo M.O.

Vielen Dank für die perfekte Lösung. Ich hätte wohl noch einen weiteren Tag gebastelt, um die Anführungszeichen richtig zu setzen.
Ich konnte das script so erweitern, daß ich nun weitere Zellen auslesen kann. Nun kann ich mich an die gesammelten Dateien der letzten Jahre machen ...

Herzlichen Dank auch an die Unterstützung von nighty und Excelking - ich bin begeistert von dieser funktionierenden community.

LG
Thomas