Sub CopyPara()
    
    Dim testRng, oRng, newRng As Range
    Dim beforeTable, EOD As Boolean
    'end of cell char
    EOC = Chr(13) & Chr(7)
    
    EOD = False
    beforeTable = False
    'move selection to begining of the doc
    Selection.HomeKey Unit:=wdStory
    
    Do Until Selection.End = ActiveDocument.Range.End
        If counter > 0 Then
            Selection.MoveDown Unit:=wdParagraph, Count:=1
        Else
            Set oRng = Selection.Paragraphs(1).Range
        End If
        'select the first para
        Selection.Paragraphs(1).Range.Select
        
        Set oRng = Selection.Paragraphs(1).Range
      
        Set testRng = Selection.Next(Unit:=wdParagraph, Count:=1)

        'test if next para is in a table
        If Not testRng Is Nothing Then
            If testRng.Information(wdWithInTable) Then beforeTable = True
        End If
        'if it is last para oof the doc, exit loop
        If oRng.End = ActiveDocument.Range.End Then
            EOD = True
            MsgBox ("EOC = " & EOD)
            Exit Do
        End If
        
        'count the characters
        char_count = Len(Trim(Selection.Paragraphs(1).Range))
        
        'check if empty para
        If char_count > 2 Then
            
            If oRng.Text Like "*" & EOC Or EOD Or beforeTable Then 'check if selection reach end of cell
                EOCCopyPaste (oRng)  'Do the EOC copy and paste
                beforeTable = False
            Else
                NormalCopyPaste (oRng) 'Do the nomal copy and paste
            End If
        End If
       
        'move selection to new paragraph
        Selection.Move Unit:=wdParagraph, Count:=1
       
   
    Loop
    
End Sub

Function NormalCopyPaste(ByVal Rng As Range)
Dim newRng As Range
                Set newRng = Rng.Duplicate
                'move the selection to the front of new range
                newRng.Collapse Direction:=wdCollapseEnd
                newRng.FormattedText = Rng.FormattedText
                Rng.Font.Hidden = True
                newRng.Font.Color = wdColorBlue
                'move selection to end of new range
                Selection.End = newRng.End
                
End Function
Function EOCCopyPaste(ByVal Rng As Range)
Dim newRng As Range
                'exclude the EOC character
                Rng.End = Rng.End - 1
                'Debug.Print Rng.Text
                'insert a para
                Rng.InsertParagraphAfter
                'duplicate the range
                Set newRng = Rng.Duplicate
                'move the selection to the front of new range
                newRng.Collapse Direction:=wdCollapseEnd
                'paste the new range
                newRng.FormattedText = Rng.FormattedText
                'change color
                newRng.Font.Color = wdColorGreen
                '
                'newRng.Next.Delete
                'remove the para mark
                'newRng.Text = Replace(newRng.Text, vbCr, "")
                'set the old range to hidden
                Rng.Font.Hidden = True
                'move the selection to the end of new range
                Selection.End = newRng.End
              
End Function

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

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