Sub PasteCleanUpText() 
     
    Application.ScreenUpdating = False 
     
    Dim oRng As Range 
    Set oRng = Selection.Range 
    oRng.Paste 
     'oRng = Replace(oRng, Chr(13), " ")
     
    oRng.ParagraphFormat.Reset 
    oRng.Font.Reset 
     
    With oRng.Find 
        .ClearFormatting 
        .Replacement.ClearFormatting 
        .Forward = True 
        .Wrap = wdFindStop 
        .Format = False 
        .MatchAllWordForms = False 
        .MatchSoundsLike = False 
        .MatchWildcards = True 
         
         'Replace single paragraph breaks with a space
        .Text = "([!^13])([^13])([!^13])" 
        .Replacement.Text = "\1 \3" 
        .Execute Replace:=wdReplaceAll 
         
         'Replace all double spaces with single spaces
        .Text = "[ ]{2,}" 
        .Replacement.Text = " " 
        .Execute Replace:=wdReplaceAll 
         
         'Delete hypens in hyphenated text formerly split across lines
         '.Text = "([a-z])-[ ]{1,}([a-z])"
         '.Replacement.Text = "\1 \2" 'formerly \1\2
         '.Execute Replace:=wdReplaceAll
         
         'Limit paragraph breaks to one per 'real' paragraph.
        .Text = "[^13]{1,}" 
        .Replacement.Text = "^p" 
        .Execute Replace:=wdReplaceAll 
         
    End With 
     
    Application.ScreenUpdating = True 
     
End Sub