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

This should do

Sub test()
    Dim x, i As Long
    With Range("a2", Range("a" & Rows.Count).End(xlUp))
        x = Filter(Evaluate("transpose(if(isnumber(left(" & .Address & ",1)+0)," & _
                "row(1:" & .Rows.Count & "),char(2)))"), Chr(2), 0)
        If UBound(x) > -1 Then
            x = Split(Join(x, ",") & "," & .Rows.Count + 1, ",")
            For i = 0 To UBound(x) - 1
                With .Rows(x(i) & ":" & x(i + 1) - 1)
                    .Cells(1).Copy .Cells(1, 3).Resize(, 2)
                    If .Rows.Count > 1 Then
                        .Cells(1, 3).Value = Join(Application.Transpose(.Value), vbLf)
                        .Copy
                        .Cells(1, 4).PasteSpecial Transpose:=True
                    End If
                End With
            Next
        End If
    End With
End Sub