Option Explicit
Sub DateienLesen()
    Call EventsOff
    Dim Zaehler1 As Long
    Dim DateiName As String, Meldung As String
    DateiName = Dir("C:\Temp\" & "*.xls") 'pfad anpassen
    ReDim ArrayNeu(1, 96) As Variant
    ReDim ArrayA(96, 1) As Variant
    ArrayNeu() = Range(Cells(1, 1), Cells(1, 96))
    Do While DateiName <> ""
        If ThisWorkbook.Name <> DateiName Then
            Workbooks.Open Filename:="C:\Temp\" & DateiName 'pfad anpassen
            Workbooks(DateiName).Worksheets("Tabelle2").Activate 'worksheetname anpassen
            ArrayA() = Range("B5:B100")
            For Zaehler1 = 1 To 96
                ArrayNeu(1, Zaehler1) = ArrayA(Zaehler1, 1)
            Next Zaehler1
            With ThisWorkbook.Worksheets("Tabelle2") 'worksheetname anpassen
                .Range(.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 96)) = ArrayNeu()
                Workbooks(DateiName).Close
                DateiName = Dir
            End With
        End If
    Loop
    Call EventsOn
End Sub 

Public Sub EventsOff()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
End Sub 

Public Sub EventsOn()
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub