Dateinamen einfügen mit VBA

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
     
     With ActiveSheet
        If .FilterMode Then .ShowAllData
     End With
     
     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 Tabelle5.Range(B9)
             .Formula = =LOOKUP(9,1/(' & sPfad & [ & sDatei & ]Tabelle5'!$B:$B<>),ROW(' & sPfad & \[ & sDatei & ]Tabelle5'!$B:$B))
             lngLZ = .Value
         End With
         
         With Tabelle5
             If blnÜberschrift Then
                 .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Resize(lngLZ - 1, 13).Formula = _
                 =' & sPfad & [ & sDatei & ]Tabelle5'!B9
             Else
                 blnÜberschrift = True
                 .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Resize(lngLZ, 13).Formula = _
                 =' & sPfad & [ & sDatei & ]Tabelle5'!B9
             End If
         End With
         
         Call StatusBalken(Int((i / UBound(vFileToOpen)) * 100))
     Next
     
     With Tabelle5.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

 Sub StatusBalken(ProzentSatz) ''ProzentSatz = Int((i / 10000) * 100)
     Dim Mess, Z, Rest
     Static oldStatusBar As Integer
     Static blnInit As Boolean

     If Not blnInit Then
         oldStatusBar = Application.DisplayStatusBar
         Application.DisplayStatusBar = True
     End If
     
     Mess = 
     For Z = 1 To ProzentSatz
         Mess = Mess & ChrW(Val(&H25A0))
     Next Z
     Rest = 100 - ProzentSatz
     For Z = 1 To Rest
         Mess = Mess & ChrW(Val(&H25A1))
     Next Z
     Application.StatusBar = Mess &   & ProzentSatz & %
     
     If Rest <= 0 Then
         Application.StatusBar = False
         Application.DisplayStatusBar = oldStatusBar
     End If
 End Sub