Option Explicit
Sub Récap()
Dim c&, i&, l&, Wb As Workbook
Dim Rep$, Temp$
Cells.Clear
Temp = Dir(ActiveWorkbook.Path & "\*.xls")
Application.DisplayAlerts = False
c = 2
Do While Temp <> ""
  If Temp Like "*-*-????.xls" Then
    Application.DisplayAlerts = 0
    Workbooks.Open ActiveWorkbook.Path & "\" & Temp
      With ThisWorkbook.Sheets(1)
        .Cells(1, c) = [E1]
        For i = 8 To [D65536].End(3).Row
          If Cells(i, 4) = "AUTRE RUBRIQUE" Then Exit For
          If Left(Cells(i, 4), 1) = UCase(Left(Cells(i, 4), 1)) And IsNumeric(Mid(Cells(i, 4), 2, 7)) Then
            On Error Resume Next
            l = Application.Match(Left(Cells(i, 4), 8), .Columns(1), 0)
            On Error GoTo 0
            If l <> 0 Then
              .Cells(l, c) = .Cells(l, c) + 1
             Else
              l = .[A65536].End(3)(2).Row
              .Cells(l, 1) = Left(Cells(i, 4), 8)
              .Cells(l, c) = .Cells(l, c) + 1
            End If
          End If
        l = 0
        Next
      End With
    Workbooks(Temp).Close
    c = c + 1
  End If
  Temp = Dir
Loop
Rows(1).NumberFormat = "m/d/yyyy"
Cells(1, c) = "Total"
Cells(2, c).FormulaLocal = "=somme(B2:" & Replace(Cells(2, c - 1).Address, "$", "") & ")"
[D2].AutoFill [D2].Resize([A65536].End(3).Row - 1)
Range("A1").Select
End Sub