Sub TranslationPrep()
  Dim iPar As Double, aRng As Range, aPar As Paragraph
  Dim iCount As Double, aRngAdd As Range, iExtra As Integer
  Dim sPar As String
  With ActiveDocument
    For iPar = .Paragraphs.Count To 1 Step -1
      Set aPar = .Paragraphs(iPar)
      Set aRng = aPar.Range
      If Len(Trim(aRng.Text)) > 2 Then
        Set aRngAdd = .Range(aRng.Start, aRng.Start)
        sPar = Trim(Split(aRng.Text, vbCr)(0))
        aRngAdd.Text = sPar & vbCr
        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