Sub Worksheet_Activate()
Dim Tablo, T, DL%, L%, Lt%
Application.ScreenUpdating = False
DL = Sheets("Feuil1").[B10000].End(xlUp).Row
Tablo = Sheets("Feuil1").Range("A2:D" & DL)
ReDim T(1 To UBound(Tablo), 1 To 3)
[A2:C10000].ClearContents: Lt = 0
For L = 1 To UBound(Tablo)
If Tablo(L, 1) <> "" Then
Lt = Lt + 1
T(Lt, 1) = Tablo(L, 1): T(Lt, 2) = Tablo(L, 2)
T(Lt, 3) = Format(Tablo(L, 4), "#0.00")
Else
T(Lt, 2) = T(Lt, 2) & " " & Tablo(L, 2)
End If
Next L
[A2].Resize(UBound(T, 1), 3) = T
Columns.AutoFit
End Sub