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