Bonjour,
Un test avec le jeu de données fourni :
Sub FUSION()
Dim I%, L%, T$
Application.ScreenUpdating = False
With ActiveSheet
I = .Cells(.Rows.Count, 2).End(xlUp).Row
For L = I To 4 Step -1
If .Cells(L, 1) = "" Then
T = .Cells(L, 2) & vbNewLine & T
Else
T = .Cells(L, 2) & vbNewLine & T
.Cells(L, 2) = Left(T, Len(T) - 1)
.Rows(L + 1 & ":" & I).EntireRow.Delete
I = L - 1
T = ""
End If
Next L
End With
Application.ScreenUpdating = True
End Sub
Dans l'attente de votre retour après test sur votre fichier complet.
Cdlt,