Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, tablo, t As String, i As Long
Set r = Intersect(Target, Range("B7:C" & Rows.Count), Me.UsedRange)
If r Is Nothing Then Exit Sub
tablo = Range("F7:H" & Cells(Rows.Count, "F").End(xlUp).Row)
For Each r In Intersect(r.EntireRow, [B:B]) 'si plusieurs cellules
t = ""
For i = 1 To UBound(tablo)
If tablo(i, 3) = r And tablo(i, 2) = r(1, 2) _
Then t = t & vbLf & tablo(i, 1)
Next
r(1, 3) = Mid(t, 2)
r(1, 3).WrapText = True 'renvoi à la ligne
r.EntireRow.AutoFit 'ajustement
Next
End Sub