Servus Sven,

einmal leise weinend davon abgesehen dass der Code wohl der langsamste seiner Art.

mit der Boolean ob mit / oder ohne Überschriften musste schon vor dem Aufruf der eigentlichen Sub die Bereichsgrößen festlegen.

PS: sag Stefan Bescheid, dass es so funktioniert

Option Explicit

Sub MitFormeln()

   'leeren, wenn nötig
   Sheets("Tabelle1").UsedRange.Offset(1).Clear
   
   'die Quellen haben
   Zusammenführen True        'Überschriften - oder auch nicht (False)

End Sub

Private Sub Zusammenführen(blnÜberschrift As Boolean)
     Dim i               As Long
     Dim sPfad           As String
     Dim sDatei          As String
     Dim vFileToOpen     As Variant
     Dim lngLZ           As Long
     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("A2")
             .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, 12).Formula = _
                 "='" & sPfad & "[" & sDatei & "]Tabelle1'!A2"
             Else
     
                 .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(lngLZ, 12).Formula = _
                 "='" & sPfad & "[" & sDatei & "]Tabelle1'!A1"
             End If
         End With
         'der Schmarrn bremst doch nur
         'Call StatusBalken(Int((i / UBound(vFileToOpen)) * 100))
     Next
     
     With Tabelle1.UsedRange
         .Copy
         .PasteSpecial xlPasteValues
         .Rows(2).Delete
     End With
     
ENDE:
     Application.EnableEvents = True
     Application.Calculation = iCalc
     Application.ScreenUpdating = True
     If Err Then MsgBox Err.Description, , "Fehler: " & Err

End Sub