Option Explicit
Sub test()
Dim lr&, i&, j&, chuoi As String, st As String, u As Range
lr = Cells(Rows.Count, 4).End(xlUp).Row
chuoi = Range("L1").Value 'nhap giá tri chuoi can tim vao 1 o trong nao do, vi du: o L1
Application.DisplayAlerts = False ' Tat canh bao khi merge cells
For i = 5 To lr
j = 0: Set u = Nothing
If Cells(i, 4) Like chuoi & "*" Then GoTo z ' neu o chua gia tri can tim thi bo qua
Do While Not Cells(i + j, 4) Like chuoi & "*" And j <= 4 ' thuc hien khi o khong chua gia tri can tim VA so lan lap <=4
If u Is Nothing Then
Set u = Cells(i + j, 4): st = u.Value & vbLf ' u la ghep dia chi cac o lai, st la ghep chuoi text
Else
Set u = Union(u, Cells(i + j, 4)): st = st & Cells(i + j, 4) & vbLf
End If
j = j + 1
Loop
u.Merge: u.Value = st ' merge cac o da ghep, dan gia tri moi vao o da merge
i = i + j - 1
z:
Next
Application.DisplayAlerts = True
End Sub