Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, resu(), i%, n%
With [B5:B10100]
If Intersect(Target, .Cells) Is Nothing Then Exit Sub
tablo = .Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
End With
ReDim resu(1 To 1, 1 To UBound(tablo))
For i = 1 To UBound(tablo)
If tablo(i, 1) <> "" Then n = n + 1: resu(1, n) = tablo(i, 1)
Next
'---restitution---
With [E3] '1ère cellule de destination, à adapter
If n Then .Resize(, n) = resu
.Offset(, n).Resize(, Columns.Count - n - .Column + 1).ClearContents 'RAZ à droite
End With
End Sub