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