Sub GPE()
Dim sArr(), Res()
Dim i As Long, k As Long, j As Long, sColRes As Long
Const dCol As Byte = 3 'Khai báo Khoang cách 2 cot ket qua
Const nCol As Long = 4 'Khai báo só cot ket qua
Const boSP As String = "B? s?n ph?m bao g?m"
sColRes = (nCol - 1) * dCol + 1
sArr = Range("A8", Range("A1040000").End(xlUp)).Value
ReDim Res(1 To UBound(sArr), 1 To sColRes)
k = 1: j = 0
For i = 1 To UBound(sArr)
If Not (sArr(i, 1) Like boSP) Then
If j = nCol Then j = 1: k = k + 1 Else j = j + 1
Res(k, (j - 1) * dCol + 1) = sArr(i, 1)
Else
k = k + 1
Res(k + 1, 1) = sArr(i, 1)
For n = i + 1 To UBound(sArr)
k = k + 1
Res(k, dCol + 1) = sArr(n, 1)
Next n
Exit For
End If
Next i
Range("D7:AA10000").ClearContents
Range("D7").Value = Range("A7").Value
If k Then Range("D9").Resize(k, sColRes) = Res
End Sub