(VBA) Zellen verschiedener gleichaufgebauter Dateien in Auswertungsdatei kopieren

[Betalo]

    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

[RPP63]

Moin!

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

[RPP63]

Damit das nicht so böse rüberkommt, mal ein Ansatz zum Einstieg:
Alle Dateien eines Ordners (bestimmter Dateityp) nacheinander öffnen

Gruß Ralf

[Betalo]

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

[RPP63]

Ich habe es gerade mal auf meine Ordnerstruktur angepasst.
Läuft einwandfrei durch.
Gibt es das Sheet Auswertung in der Makro-Datei?

Gruß Ralf

[Betalo]

Das erste Blatt heißt Auswertung.
Hast du ne Idee an was es sonst liegen kann?

Gruß Nico

[Käpt'n Blaubär]

Hallo Nico,

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.

[Betalo]

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

[RPP63]

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

[RPP63]

Ah, nach Ansicht Deines Screenshots verstehe ich Dein Problem!
Du solltest die Summenzeile nach ganz oben setzen.