[
attachment=9580]Hallo liebe Excel-Community,
ich möchte .xlsm-Dateien eines Ordners in einer Auswertungsdatei zusammenfassen. Jede einzelne Datei hat den selben Aufbau mit 2 Tabellenblättern, bei denen ich aber nur die Zellen des ersten Blattes brauche (Tabelle1). Zudem ist jede Datei anders benannt.
Anbei habe ich ein Muster angehängt, dass den Aufbau der Auswertungsdatei darstellt. Die Zellenbezeichnungen stehen für die Zellen, die aus den .xlsm-Dateien kopiert werden sollen.
Ich hoffe ihr könnt mir helfen :19: .
Gruß
Betalo
Moin!
Zitat:Ich hoffe ihr könnt mir helfen [img]
Dateiupload bitte im Forum! So geht es: Klick mich!
]
Vielleicht, vielleicht auch nicht, schließlich ist Deine Beschreibung mehr als dürftig.
Was hast Du bisher?
Zeig mal Deinen Code.
Oder soll das eine Auftragsarbeit werden?
Gruß Ralf
Hallo Ralf,
also den Code den ich mir zusammengesucht habe, lautet wie folgt:
Code:
Option Explicit
Dim objFileSystemObject As Object
Dim objDateien As Object
Dim objWeitereDateien As Object
Dim objDatei As Object
Dim lngFirstFreeRow As Long
Dim wksAuswertsheet As Worksheet
Sub Auswertung_start()
'Objektverweise zuweisen
Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set objDateien = objFileSystemObject.getfolder("Z:\SWF - Jeder\Vogel\Dienstreise\Übersicht Reisekosten pro Abrechnung")
Set wksAuswertsheet = ThisWorkbook.Sheets("Auswertung")
Call Dateien_auswerten
'Zuweisung wieder aufheben
Set objFileSystemObject = Nothing
Set objDateien = Nothing
Set wksAuswertsheet = Nothing
'Text aus Statusbar löschen
Application.StatusBar = ""
End Sub
Sub Dateien_auswerten()
Application.ScreenUpdating = False
For Each objDatei In objDateien.Files
If Right(objDatei.Name, 5) = ".xlsm" Then
'erste freie Zelle in der Zieldatei in Spalte A ermitteln
lngFirstFreeRow = wksAuswertsheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'Meldung in Statusbar anzeigen
Application.StatusBar = "Datei """ & objDatei.Name & """ wird ausgelesen!"
DoEvents
'Gefundene Datei unsichtbar öffnen
GetObject (objDatei)
'Wert aus geöffneter Datei aus dem Tabellenblatt 1 aus Zelle _
B8 in die erste freie Zelle in Spalte A übertragen
wksAuswertsheet.Cells(lngFirstFreeRow, 1) = _
Workbooks(objDatei.Name).Sheets(1).Range("B8")
'Wert aus geöffneter Datei aus dem Tabellenblatt 1 aus Zelle _
B10 in die erste freie Zelle in Spalte A übertragen
wksAuswertsheet.Cells(lngFirstFreeRow, 2) = _
Workbooks(objDatei.Name).Sheets(1).Range("B10")
'Wert aus geöffneter Datei aus dem Tabellenblatt 1 aus Zelle _
S7 in die erste freie Zelle in Spalte A übertragen
wksAuswertsheet.Cells(lngFirstFreeRow, 3) = _
Workbooks(objDatei.Name).Sheets(1).Range("S7 ")
'Wert aus geöffneter Datei aus dem Tabellenblatt 1 aus Zelle _
L2 in die erste freie Zelle in Spalte A übertragen
wksAuswertsheet.Cells(lngFirstFreeRow, 5) = _
Workbooks(objDatei.Name).Sheets(1).Range("L2 ")
'Wert aus geöffneter Datei aus dem Tabellenblatt 1 aus Zelle _
D24 in die erste freie Zelle in Spalte A übertragen
wksAuswertsheet.Cells(lngFirstFreeRow, 8) = _
Workbooks(objDatei.Name).Sheets(1).Range("D24")
'Wert aus geöffneter Datei aus dem Tabellenblatt 1 aus Zelle _
B27 in die erste freie Zelle in Spalte A übertragen
wksAuswertsheet.Cells(lngFirstFreeRow, 9) = _
Workbooks(objDatei.Name).Sheets(1).Range("B27 ")
'Wert aus geöffneter Datei aus dem Tabellenblatt 1 aus Zelle _
D22 in die erste freie Zelle in Spalte A übertragen
wksAuswertsheet.Cells(lngFirstFreeRow, 10) = _
Workbooks(objDatei.Name).Sheets(1).Range("D22 ")
'Wert aus geöffneter Datei aus dem Tabellenblatt 1 aus Zelle _
D28 in die erste freie Zelle in Spalte A übertragen
wksAuswertsheet.Cells(lngFirstFreeRow, 14) = _
Workbooks(objDatei.Name).Sheets(1).Range("D28")
'Geöffnete Datei wieder schließen ohne zu speichern
Workbooks(objDatei.Name).Close SaveChanges:=False
End If
Next
'Nächstes Verzeichnis abfragen
For Each objWeitereDateien In objDateien.subfolders
Set objDateien = objWeitereDateien
Call Dateien_auswerten
Next
Nur dann bekomme ich folgende Fehler: Beim 1. Sub ist der Index außerhalb des Bereiches und beim 2. Sub ist die Objektvariable oder With-Blockvariable nicht festgelegt.
Und da ich von VBA nicht viel Ahnung habe, weiß ich nicht wie ich das Programm zum laufen bringe.
Gruß
Nico
Ich habe es gerade mal auf meine Ordnerstruktur angepasst.
Läuft einwandfrei durch.
Gibt es das Sheet Auswertung in der Makro-Datei?
Gruß Ralf
Das erste Blatt heißt Auswertung.
Hast du ne Idee an was es sonst liegen kann?
Gruß Nico
Hallo Nico,
Zitat:Das erste Blatt heißt Auswertung.
Hast du ne Idee an was es sonst liegen kann?
Gruß Nico
Schau mal nach Leerzeichen, die sich eingeschlichen haben können.
" Auswertung" ist nun mal was anderes als " Auswertung " oder "Auswertung " und dgl. mehr.
Hallo,
hat geklappt, danke für den Hinweis.
nur wird mir alles unter der ganzen Tabelle geschrieben. Das ist noch etwas unschön. Wie kann ich es abändern, damit Excel in die erste Zeile der Tabelle schreibt? An sich ist die Zelle leer, aber erkennt Excel vielleicht die Tabellenlinien als Inhalt an?
Gruß Nico
Willst Du verhindern, dass die erste Zeile,
die keine Überschriften enthält nicht freibleibt, Nico?
Dann musst Du nach dieser Zeile
Code:
lngFirstFreeRow = wksAuswertsheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
folgendes einfügen:
Code:
If lngFirstFreeRow = 2 Then lngFirstFreeRow = 1
Gruß Ralf
Ah, nach Ansicht Deines Screenshots verstehe ich Dein Problem!
Du solltest die Summenzeile nach ganz oben setzen.