Sub SplitText()
  Dim w, r&, r2&, s$, v$, ar, i&, n&, n1&, n2&
  With Worksheets(Worksheets.Count)
    .Columns(20).ClearContents:  w = .Cells(1, 20).Left - .Cells(1, 2).Left
    r = 5: r2 = 5
    Do While Not IsEmpty(Cells(r, 2))
      v = Cells(r, 2):  .Cells(1, 20) = v:  .Columns(20).AutoFit
      If .Cells(1, 20).Width <= w Then
        .Cells(r2, 2) = v: r2 = r2 + 1
      Else
        Do While True
          ar = Split(v): n2 = UBound(ar): n1 = 0
          Do While n2 - n1 > 1
            s = "":  n = (n2 + n1) / 2
            For i = 0 To n: s = s & ar(i) & " ": Next
            .Cells(1, 20) = Left(s, Len(s) - 1): .Columns(20).AutoFit
            If .Cells(1, 20).Width > w Then n2 = n Else n1 = n
          Loop
          s = ""
          For i = 0 To n1: s = s & ar(i) & " ": Next
          .Cells(r2, 2) = Left(s, Len(s) - 1): r2 = r2 + 1
          If Len(v) > Len(s) Then
            v = Right(v, Len(v) - Len(s)): .Cells(1, 20) = v: .Columns(20).AutoFit
            If .Cells(1, 20).Width < w Then .Cells(r2, 2) = v: r2 = r2 + 1: Exit Do
          Else
            Exit Do
          End If
        Loop
      End If
      r = r + 1
    Loop
    .Cells(1, 20).ClearContents
  End With
End Sub