Option Explicit

Sub jjj()
Dim arr(), arrOut()
Dim wshNew As Worksheet
Dim i&, r&, c&, n&

    With ActiveSheet: arr = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row).Value: End With
    n = UBound(arr, 1)
    If n < 3 Then Exit Sub
    ThisWorkbook.Sheets.Add after:=ActiveSheet
    Set wshNew = ActiveSheet
    
    i = 1
    r = 1
    While i < n
        c = 1
        While Not arr(i, 1) Like "*</offer>*" And i < n
            wshNew.Cells(r, c).Value = arr(i, 1)
            i = i + 1
            c = c + 1
        Wend
        i = i + 1
        r = r + 1
    Wend

End Sub