Private Sub Worksheet_Change(ByVal Target As Range)
Dim t, a$, resu(), i&, j&, x, k&, n&
Application.EnableEvents = False 'désactive les évènements
With Range("A1", UsedRange)
t = .Columns(2).Resize(, 4) 'matrice, plus rapise
a = .Columns(5).Address
ReDim resu(1 To Evaluate("SUM(IF(ISNUMBER(" & a & "),INT(" & a & ")))"), 1 To 1)
For i = 6 To UBound(t)
j = Int(Val(t(i, 4)))
x = t(i, 1)
For k = 1 To j
n = n + 1
resu(n, 1) = x
Next k, i
If n Then
.Cells(6, 7).Resize(n) = resu 'restitution
.Cells(6, 7).Resize(n).Interior.ColorIndex = 36 'jaune
End If
.Cells(n + 6, 7).Resize(Rows.Count - n - 5).ClearContents 'RAZ en dessous
.Cells(n + 6, 7).Resize(Rows.Count - n - 5).Interior.ColorIndex = 2 'blanc
End With
With UsedRange: End With 'actualise la barre de défilement verticale
Application.EnableEvents = True 'réactive les évènements
End Sub