Sub TranslationPrep()
  Dim iPar As Double, aRng As Range, aPar As Paragraph
  Dim iCount As Double, aRngAdd As Range, iExtra As Integer
  With ActiveDocument
    For iPar = .Paragraphs.Count To 1 Step -1
      Set aPar = .Paragraphs(iPar)
      Set aRng = aPar.Range
      If Len(aRng) > 2 Then
        Set aRngAdd = .Range(aRng.Start, aRng.Start)
        iExtra = Len(aRng.Text) - Len(Split(aRng.Text, vbCr)(0))
        If iExtra > 1 Then
          aRng.End = aRng.End - iExtra
          aRngAdd.FormattedText = aRng.FormattedText
          aRngAdd.InsertParagraphAfter
        Else
          aRngAdd.FormattedText = aRng.FormattedText
        End If
        aRngAdd.Font.Hidden = True
        With aRng.Paragraphs.Last.Range
          .Font.ColorIndex = wdBlue
          .ListFormat.RemoveNumbers NumberType:=wdNumberParagraph
        End With
      End If
    Next iPar
  End With
End Sub