Sub recap()
Dim DerL&, DerLR&, i&, j&, Tblo(), TbloR(), Nom_Feuille$, Recap_Feuille$
Nom_Feuille = ActiveSheet.Name
Recap_Feuille = "recapcom" & Nom_Feuille
DerL = Sheets(Nom_Feuille).Cells(Rows.Count, 28).End(xlUp).Row
DerLR = Sheets(Recap_Feuille).Cells(Rows.Count, 1).End(xlUp).Row
Sheets(Recap_Feuille).Range("A14:C" & DerLR).ClearContents
Tblo = Sheets(Nom_Feuille).Range("AB10:AD" & DerL).Value
i = 1
For j = 1 To UBound(Tblo)
If IsError(Tblo(j, 1)) Then GoTo Suite
If Tblo(j, 1) <> "" Then
ReDim Preserve TbloR(3, i)
TbloR(1, i) = Tblo(j, 1)
TbloR(2, i) = Tblo(j, 2)
TbloR(3, i) = Tblo(j, 3)
i = i + 1
End If
Suite:
Next
Sheets(Recap_Feuille).Range("A14").Resize(UBound(TbloR, 2), 3) = Application.Transpose(TbloR)
End Sub