Thema Datum  Von Nutzer Rating
Antwort
Rot Mehrere Excel-Dateien zu einer Datei zusammenfassen
14.10.2020 12:52:16 MH
NotSolved
14.10.2020 13:57:33 Gast93089
NotSolved
14.10.2020 16:38:06 Gast84114
NotSolved
14.10.2020 17:49:46 Gast12967
NotSolved
15.10.2020 10:23:10 Gast25351
NotSolved
15.10.2020 13:11:43 Gast86679
NotSolved

Ansicht des Beitrags:
Von:
MH
Datum:
14.10.2020 12:52:16
Views:
66
Rating: Antwort:
  Ja
Thema:
Mehrere Excel-Dateien zu einer Datei zusammenfassen
Hallo allerseits,
ich möchte gerne mehrere Excel-Dateien in einem Ordner, die jeweils eine Tabelle enthalten, in einer Master-Datei zusammenführen. Anbei mein aktueller Code.

Die erste Datei soll vollständig übernommen werden, ab der 2. Datei reicht die Tabelle jeweils ab Zelle D10.

Beim Ausführen der Datei erhalte ich allerdings einen Laufzeitfehler 1004. Die beim Debuggen hervorgehoben Zeile habe ich unten kommentiert. 

Kann mir hier jemand weiterhelfen, wie der Fehler zu beheben ist?

Vielen Dank!!!

---

Sub Merge_tables()
    Dim strVerzeichnis As String
    Dim strTyp As String
    Dim strDateiname As String
    Dim lngZeile As Long
    Dim nbr As Long
    nbr = 0
    strTyp = "*.xls*"
    Application.ScreenUpdating = False
    strVerzeichnis = "Ordnerpfad" 'Hier Ordner mit Einzeldateien definieren
    strDateiname = Dir(strVerzeichnis & strTyp)
    lngZeile = 10
    
    With ThisWorkbook.Worksheets("Tabelle1")
    
        Do While strDateiname <> ""
            
            nbr = nbr + 1
            
            If nbr = 1 Then
                        
                'Einzeldatei öffnen
                Workbooks.Open Filename:=strVerzeichnis & strDateiname
                        
                'Letzte Zeile der Einzeldatei bestimmen
                Letzte_zeile = ActiveWorkbook.Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 'In Spalte 5 wird nach letzter zu kopierender Zeile gesucht
                                        
                'Erste Einzeldatei in Gesamtdokument kopieren
                ActiveWorkbook.Worksheets(1).Range("A1:CZ" & Letzte_zeile).Copy .Cells(1, 1) 'Erste Einzeldatei wird bis Spalte CZ in Zelle A1 kopiert
            
                'Einzeldatei speichern und schließen
                ActiveWorkbook.Close True
                strDateiname = Dir
                lngZeile = lngZeile + Letzte_zeile - 10
                
            Else
            
                'Einzeldatei öffnen
                Workbooks.Open Filename:=strVerzeichnis & strDateiname
                        
                'Letzte Zeile der Einzeldatei bestimmen
                Letzte_zeile = ActiveWorkbook.Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 'In Spalte 5 wird nach letzter zu kopierender Zeile gesucht
                        
                'Restliche Einzeldateien in Gesamtdokument kopieren
                ActiveWorkbook.Worksheets(1).Range("D10:CZ" & Letzte_zeile).Copy .Cells(lngZeile, 4) 'Restliche Einzeldateien werden bis Spalte CZ in Spalte D kopiert/angehängt ### ZEILE BEIM DEBUGGEN HERVORGEHOBEN ###
            
                'Einzeldatei speichern und schließen
                ActiveWorkbook.Close True
                strDateiname = Dir
                lngZeile = lngZeile + Letzte_zeile - 10
            
            End If
            
        Loop
    
    End With
    
    Application.ScreenUpdating = True

End Sub


 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst genau und ausführlich
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
  • Bitte markieren Sie Ihre Anfrage als erledigt wenn Ihnen geholfen wurde
Thema: Name: Email:

 
 

Thema Datum  Von Nutzer Rating
Antwort
Rot Mehrere Excel-Dateien zu einer Datei zusammenfassen
14.10.2020 12:52:16 MH
NotSolved
14.10.2020 13:57:33 Gast93089
NotSolved
14.10.2020 16:38:06 Gast84114
NotSolved
14.10.2020 17:49:46 Gast12967
NotSolved
15.10.2020 10:23:10 Gast25351
NotSolved
15.10.2020 13:11:43 Gast86679
NotSolved