Option Explicit
Sub Recapitulation()
   Dim ws As Worksheet, dl As Long, dl2 As Long, Fr As Worksheet, c As Range
   Set Fr = ThisWorkbook.Worksheets("recap")
   Application.ScreenUpdating = False
   With Fr
      dl = .Cells(Rows.Count, 1).End(xlUp).Row
      If dl > 5 Then .Range(.Cells(6, 1), .Cells(dl, 12)).ClearContents
   End With
   For Each ws In Worksheets
      If ws.Name <> "RECAP" Then
         dl2 = ws.Cells(Rows.Count, 1).End(xlUp).Row
         For Each c In ws.Range(ws.Cells(6, 1), ws.Cells(dl2, 1))
            dl = Fr.Cells(Rows.Count, 1).End(xlUp).Row + 1
            Fr.Cells(dl, 1) = c
            Fr.Cells(dl, 2) = c.Offset(0, 1)
            Fr.Cells(dl, 3) = ws.Name
            Fr.Cells(dl, 4) = c.Offset(0, 2)
            Fr.Cells(dl, 5) = c.Offset(0, 3)
            Fr.Cells(dl, 6) = c.Offset(0, 4)
            Fr.Cells(dl, 7) = c.Offset(0, 5)
            Fr.Cells(dl, 8) = c.Offset(0, 6)
            Fr.Cells(dl, 9) = c.Offset(0, 7)
            Fr.Cells(dl, 10) = c.Offset(0, 8)
            Fr.Cells(dl, 11) = c.Offset(0, 9)
            Fr.Cells(dl, 12) = c.Offset(0, 10)
         Next c
      End If
   Next
   Application.ScreenUpdating = True
   MsgBox "Recap terminée!", vbInformation + vbOKOnly, "TRAITEMENT"
End Sub