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
 
 
    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
 
 
    For i = 1 To UBound(vFileToOpen)
        sDatei = Dir(vFileToOpen(i))
        sPfad = Left(vFileToOpen(i), InStr(vFileToOpen(i), sDatei) - 1)
 
        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
                .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(lngLZ - 1, _
                  7).Formula = _
                "='" & sPfad & "[" & sDatei & "]Tabelle1'!A2"
            Else
                blnÜberschrift = True
                .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(lngLZ, _
                  7).Formula = _
                "='" & sPfad & "[" & sDatei & "]Tabelle1'!A1"
            End If
        End With
 
        Call StatusBalken(Int((i / UBound(vFileToOpen)) * 100))
    Next
 
    With Tabelle1.UsedRange
        .Copy
        .PasteSpecial xlPasteValues
        .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

Zitat:

Ich habe einen Watch auf die beiden variablen sPfad und sDatei gesetzt und bei der Ausführung der des Makro mit Dateien aus dem Netzwerk werden den variablen keine Werte übergeben. Woran kann das liegen?

Zitat:

Im vFileToOpen steht der gesamte Pfad zur Datei

    For i = 1 To UBound(vFileToOpen)
        sDatei = Mid$(vFileToOpen(i), InStrRev(vFileToOpen(i), "\") + 1)
        sPfad = Left$(vFileToOpen(i), InStr(vFileToOpen(i), sDatei) - 1)