Private Sub Worksheet_Change(ByVal Target As Range)
Dim col%, P As Range, t, i&
col = 4 'colonne D (où doit se trouver le résultat), à adapter
Set P = Intersect(Columns(col).Resize(, 2), Me.UsedRange.EntireRow)
t = P 'matrice, plus rapide
For i = 1 To UBound(t)
If t(i, 2) <> "" Then
t(i, 1) = t(i, 1) & t(i, 2)
t(i, 2) = ""
End If
Next
Application.EnableEvents = False: P = t: Application.EnableEvents = True
End Sub