I have a spreadsheet full of data. In column “H” I have cells upon cells of between 3-7 paragraphs. Ideally I would like to split the cell into 2 paragraph max length cells and merge the remaining paragraphs down with that same rule. I have working VBA that will do this every paragraph. End goal is to instead do this every “x” paragraphs (ideally “2” paragraphs) for cells that contain lots of text. Thanks for any pointers!

I did take a brief dive into split string based on character count, but my attempts messed with paragraph ends.

Sub splitcells()
  Dim InxSplit As Long
  Dim SplitCell() As String
  Dim RowCrnt As Long
  With Worksheets("Sheet1")

    RowCrnt = 10         ' The first row containing data.

    Do While True

      ' * I use .Cells(row, column) rather than .Range because it is more
      '   convenient when you need to change the row and/or column numbers.
      ' * Note the column value can be a number or a column identifier.
      '   A = 1, B=2, Z=26, AA = 27, etc.  I am not doing arithmetic with
      '   the columns so I have used "A" and "B" which I find more
      '   meaningful than 1 and 2.

      If .Cells(RowCrnt, "H").Value = "" Then

        Exit Do

      End If

      SplitCell = Split(.Cells(RowCrnt, "H").Value, Chr(10))

      If UBound(SplitCell) > 0 Then
        ' The cell contained a line break so this row is to be spread across
        ' two or more rows.
        ' Update the current row

        .Cells(RowCrnt, "H").Value = SplitCell(0)

        ' For each subsequent element of the split value, insert a row
        ' and place the appropriate values within it.

        For InxSplit = 1 To UBound(SplitCell)
          RowCrnt = RowCrnt + 1

          ' Push the rest of the worksheet down
          .Rows(RowCrnt).EntireRow.Insert
          ' Select the appropriate part of the original cell for this row
          .Cells(RowCrnt, "H").Value = SplitCell(InxSplit)
          ' Copy the value from column B from the previous row
          .Cells(RowCrnt, "A").Value = .Cells(RowCrnt - 1, "A").Value
          .Cells(RowCrnt, "B").Value = .Cells(RowCrnt - 1, "B").Value
          .Cells(RowCrnt, "C").Value = .Cells(RowCrnt - 1, "C").Value
          .Cells(RowCrnt, "D").Value = .Cells(RowCrnt - 1, "D").Value
          .Cells(RowCrnt, "E").Value = .Cells(RowCrnt - 1, "E").Value
          .Cells(RowCrnt, "F").Value = .Cells(RowCrnt - 1, "F").Value
          .Cells(RowCrnt, "G").Value = .Cells(RowCrnt - 1, "G").Value
          .Cells(RowCrnt, "I").Value = .Cells(RowCrnt - 1, "I").Value
          .Cells(RowCrnt, "J").Value = .Cells(RowCrnt - 1, "J").Value
          .Cells(RowCrnt, "K").Value = .Cells(RowCrnt - 1, "K").Value
          .Cells(RowCrnt, "L").Value = .Cells(RowCrnt - 1, "L").Value
          .Cells(RowCrnt, "M").Value = .Cells(RowCrnt - 1, "M").Value
          .Cells(RowCrnt, "N").Value = .Cells(RowCrnt - 1, "N").Value
          .Cells(RowCrnt, "O").Value = .Cells(RowCrnt - 1, "O").Value
        Next
      End If

      RowCrnt = RowCrnt + 1

    Loop

  End With

 End Sub