VBA: Wrapping text and transversing text between nubers or given speific text

maybe

Sub ertert11()
Dim r As Range, s
For Each r In Range("A1", Cells(Rows.Count, 1).End(xlUp)).SpecialCells(2).Areas
    s = Application.Transpose(r)
    r(1, 3).Resize(, UBound(s)).Value = s
Next r
End Sub

Sub ertert22()
Dim r As Range, s
For Each r In Range("A1", Cells(Rows.Count, 1).End(xlUp)).SpecialCells(2).Areas
    s = Application.Transpose(r)
    r(1, 3).Value = Join(s, Chr(10))
Next r
End Sub