Sub ketqua()
Dim s As String
Dim c As Range, clst As Range
Dim akq() As Variant, lkq As Long
s = "L" & ChrW(224) & " c" & ChrW(225) & "i g" & ChrW(236) & "?"
With Sheets("bandau")
lkq = .Cells(.Rows.Count, 1).End(xlUp).Row
ReDim akq(1 To lkq, 1 To 2)
With .Range(.Cells(1, 1), .Cells(lkq, 1))
Set c = .Find(s, LookIn:=xlValues)
If Not c Is Nothing Then
lkq = 0
Set clst = .Cells(1, 1)
Do
lkq = lkq + 1
akq(lkq, 1) = c.Offset(1, 0).Value
akq(lkq, 2) = Join(Application.Transpose(Range(clst, c)), "\r\n")
Set clst = c.Offset(2, 0)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Row > clst.Row
End If
End With
End With
Sheets("ketqua").Range("A1").Resize(lkq, 2).Value = akq
Set shkq = Nothing
Set c = Nothing
Set clst = Nothing
End Sub