Ach ja, der Status bar geht so nicht.

Option Explicit
 
Sub Zusammenfuegen()
Dim A As Object
Set A= Application

    With A
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
  
    Dim DateiName(1 To 2) As String
    Dim Pfad(1 To 2) As String
    Dim i As Long
    Dim nWB As Workbook
    Dim lz As Long, efz As Long, z As Long      'lz=letzte Zeile; efz=erste freie Zeile
    Dim offs As Long                            'offset
    Dim nW As String
    Dim AV, rng As Range, R&, lastR&, nSh As Worksheet,
     
    Pfad(1) = Workbooks("Makros.xlsm").Path & "\"
    Pfad(2) = Workbooks("Makros.xlsm").Path & "\"
     
    DateiName(1) = "Teil1.xls"
    DateiName(2) = "Teil2.xls"
           
    Set nWB = Workbooks.Add
    Set nSh = nWB.Sheets(1)
    With nSh
    .Cells(1, 1).Value = "Ü1"
    .Cells(1, 2).Value = "Ü2"
    .Cells(1, 3).Value = "Ü3"
    .Cells(1, 4).Value = "Ü4"
    .Cells(1, 5).Value = "Ü5"
    End With
    efz = nSh.Range("A65536").End(xlUp).Row + 1
     
    For i = 1 To 2
     
        Workbooks.Open Filename:=Pfad(i) & DateiName(i)
        lz = Cells(Rows.Count, 5).End(xlUp).Row
        Set rng = Range(Cells(1, 1), Cells(lz, 5))
        AV = rng.Value
         
        For z = 1 To lz
            If (AV(z + 1, 2) <> "Ausschluss1") And (AV(z + 1, 2) <> "Ausschluss2") And (AV(z + 1, 2) <> "Ausschluss3") And (AV(z + 1, 2) <> "Ausschluss4") Then
  
                Select Case AV(z + 1, 8)
                        Case Is = "Ü2"
                            offs = 1
                        Case Is = "Ü3"
                            offs = 2
                        Case Is = "Ü4"
                            offs = 3
                        Case Is = "Ü5"
                            offs = 4
                End Select
             
                nW = Val(Mid(AV(z + 1, 5), 1, 4) & "00" & Mid(AV(z + 1, 5), 5, 8))
                If AV(z + 1, 5) = AV(z, 5) Then
                    With nSh.Range("A:A").Find(What:=nW).Offset(0, offs)
                        .Value = .Value + AV(z + 1, 13)
                    End With
                Else
                    With nSh
                        .Cells(efz, 1).Value = nW
                        .Cells(efz, offs + 1).Value = _
                        .Cells(efz, offs + 1).Value + AV(z + 1, 13)
                        efz = efz + 1
                    End With
                End If
                 
            End If
             
            'status bar
                If R = lastR + 100 Or R = lz Then
                    A.statusbar= "Zeile: " & R & "/" & lz
                    lastR = R
                End If
        Next z
        lastR = 0
        Workbooks(DateiName(i)).Close (False)
        A.statusbar= "Files: " & i & "/" & 2
    Next i
     
    With nWB
    .SaveAs Filename:=Workbooks("Makros.xlsm").Path & "\" & Format(Date, "YYYYMMDD") & "_Ergebnis.xls"
    'wenn "makros.xlsm" DIESES workbook ist kannst du auch "thisworkbook" verwenden
    .Close (False)
    End With
     
    With A
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
  
    MsgBox "Datei unter " & Workbooks("Makros.xlsm").Path & "\" & Format(Date, "YYYYMMDD") & "_Ergebnis.xls gespeichert."
  
End Sub