Mehrere Excel-Dateien zusammenführen

[mort92]

Hallo zusammen,

meine Excel-Kenntnisse (insbesondere meine VBA Fertigkeiten) sind leider mehr als eingerostet und im Zuge eines Praktikums soll ich mehrere Excel-Dateien zu einer großen Master Datei zusammenführen.
Dies wurde bisher durch einfaches Copy-Paste erledigt. Das war mir aber etwas zu langwierig, daher habe ich diesen Code ausprobiert, den ich online gefunden habe:

---

Code:

Sub Zusammenführen()
    Dim i               As Long
    Dim sPfad           As String
    Dim sDatei          As String
    Dim vFileToOpen     As Variant
    Dim lngLZ           As Long
    Dim blnÜberschrift  As Boolean
    Dim iCalc           As Integer
    Dim lngTitel1       As Long
    Dim lngDaten1       As Long
    Dim lngSpalteL      As Long
    
    lngTitel1 = 13    '1. Zeile mit Titeln die übertragen werden soll, _
          wenn keine Titel übertragen werden sollen, dann diesen Wert = cLngDaten1 setzen
    lngDaten1 = 14 '1. Zeile mit Daten die übertragen werden soll
    lngSpalteL = 43 'letzte Spalte mit Daten die übertragen werden soll
    
    vFileToOpen = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , , , True)
    If Not IsArray(vFileToOpen) Then Exit Sub
    
        
    iCalc = Application.Calculation

    On Error GoTo ENDE:
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    With Tabelle1
        'Hilfszeile einfügen vor Zeile 1
        .Rows(1).Insert
    End With
    
    For i = 1 To UBound(vFileToOpen)
        sDatei = Dir(vFileToOpen(i))
        sPfad = Left(vFileToOpen(i), InStr(vFileToOpen(i), sDatei) - 1)
    
        'Anzahl Datenzeilen in Quelle  in Spalte A in Zelle A1 per Formel ermitteln
        With Tabelle1.Range("A1")
          .Formula = "=LOOKUP(2,1/('" & sPfad & "[" & sDatei _
                    & "]Tabelle1'!$A:$A<>""""),ROW('" & sPfad & "\[" & sDatei _
                    & "]Tabelle1'!$A:$A))"
          lngLZ = .Value
        End With
        
        With Tabelle1
            If blnÜberschrift Then
                'Bei 2. und folgender Datei nur die Daten übertragen
                .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(lngLZ - lngDaten1 + 1, _
                    lngSpalteL).Formula = _
                    "='" & sPfad & "[" & sDatei & "]Tabelle1'!A" & lngDaten1
            Else
                'Bei 1. Datei die Daten ggf. inklusive Titelzeile(n) übertragen
                blnÜberschrift = True
                .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(lngLZ - lngTitel1 + 1, _
                    lngSpalteL).Formula = _
                    "='" & sPfad & "[" & sDatei & "]Tabelle1'!A" & lngTitel1
            End If
        End With
    Next
    
    With Tabelle1.UsedRange
        'Formeln durch Werte ersetzen
        .Copy
        .PasteSpecial xlPasteValues
        'Hilfszeile wieder löschen
        .Rows(1).Delete
    End With
    
ENDE:
    Application.EnableEvents = True
    Application.Calculation = iCalc
    Application.ScreenUpdating = True
    If Err Then MsgBox Err.Description, , "Fehler: " & Err
End Sub
[hr]

---

Wenn ich diesen Code ausführe, kann ich den entsprechenden Ordner mit den Excel-Dateien auswählen, danach folgt aber leider der Fehler:

"Anwendungs- oder objektdefinierter Fehler" bzw. ich hatte auch schon den "Laufzeitfehler 13".

Die zusammenzuführenden Excel-Tabellen sind alle gleich aufgebaut, nach folgendem Format:

   

Ich danke euch schon mal im Voraus!

EDIT: Jetzt klappt es bei manchen Ordnern, bei anderen aber wieder nicht? Ich bin überfragt 

[schauan]

Hallöchen,

für eine Fehleranalyse solltest Du diese Zeile
On Error GoTo ENDE:
auskommentieren und schauen, wo der Fehler auftritt. Dann kann man gezielter nach der Ursache suchen.

[mort92]

Hallöchen,

für eine Fehleranalyse solltest Du diese Zeile
   On Error GoTo ENDE:
auskommentieren und schauen, wo der Fehler auftritt. Dann kann man gezielter nach der Ursache suchen.

heyho schauan,

danke für deine Hilfe
Ich habe die Zeile auskommentiert. Es erscheint der Fehler: 

Laufzeitfehler '13':

Typen unverträglich

Also generell soll der Code es schaffen, aus der ersten Excel Datei, die er öffnet alles zu kopieren. Die erste Zeile (die mit den Überschriften), soll nur beim ersten Mal mitkopiert werden.
Dann sollen die nachfolgenden Excel Dateien stumpf ab der zweiten Zeile kopiert werden und werden in einer Excel Datein zusammengeführt.

Wenn ich wenige Excel-Dateien auswähle (mit dem oben angezeigten Code) erscheint folgender Fehlercode:

Laufzeitfehler '1004':

Anwendungs- oder objektdefinierter Fehler.

Ich danke dir schonmal für deine Mühe 


Beste Grüße,

Thorben

[Rabe]

Hi Thorben,

Ich habe die Zeile auskommentiert. Es erscheint der Fehler: 

Laufzeitfehler '13':

Typen unverträglich

[...]
Laufzeitfehler '1004':

Anwendungs- oder objektdefinierter Fehler.

und wenn Du auf "Debuggen" gehst, welche Zeile wird dann gelb markiert?

[snb]

Oder:

Code:

Sub M_snb()
    With Application.FileDialog(1)
       .AllowMultiSelect = True
       If .Show Then
          For j = 1 To .SelectedItems.Count
             With GetObject(.SelectedItems(j))
                 sn = .Sheets(1).Cells(1).CurrentRegion.Offset(Abs(j > 1))
                 .Close 0
              End With
              
              Tabelle1.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sn), UBound(sn, 2)) = sn
          Next
        End If
    End With
End Sub

[mort92]

Hey ihr zwei.

Danke für eure Antworten.
@snb, Wahnsinn, dein Code funktioniert perfekt! Danke!!

Gibt's hier sowas wie reddit gold?  :19:


Besten Dank und Grüße!

Thorben