Private Sub Worksheet_Activate()
Dim tablo, a$, nlig&, resu(), i, x, s, j%, n&
With Feuil1.[A1].CurrentRegion 'à adapter
tablo = .Resize(, 2) 'matrice, plus rapide
a = .Columns(2).Address(External:=True)
End With
nlig = Evaluate("SUM(LEN(" & a & ")-LEN(SUBSTITUTE(" & a & ",CHAR(10),""""))+1)")
ReDim resu(1 To nlig, 1 To 2)
For i = 1 To UBound(tablo)
x = tablo(i, 1)
s = Split(tablo(i, 2), vbLf)
If UBound(s) = -1 Then
If x <> "" Then n = n + 1: resu(n, 1) = x
Else
For j = 0 To UBound(s)
n = n + 1
resu(n, 1) = x
resu(n, 2) = s(j)
Next j
End If
Next i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A1] 'à adapter
If n Then .Resize(n, 2) = resu
.Offset(n).Resize(Rows.Count - n - .Row + 1, 2).ClearContents 'RAZ en dessous
End With
Columns.AutoFit 'ajustement largeur
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub