Sub CleanUpPastedText()
'Turn Off Screen Updating
Application.ScreenUpdating = False
Dim StrFnd As String
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Forward = True
  .Wrap = wdFindStop
  .Format = False
  .MatchAllWordForms = False
  .MatchSoundsLike = False
  .MatchWildcards = True
  'Eliminate spaces & tabs before paragraph breaks.
  StrFnd = "[ ^s^t]{1,}^13"
  'Edit StrFnd as needed for internationalisation issues
  If Application.International(wdListSeparator) = ";" Then
    StrFnd = Replace(StrFnd, ",", ";")
  End If
  .Text = StrFnd
  .Replacement.Text = "^p"
  .Execute Replace:=wdReplaceAll
  'Replace single paragraph breaks and line breaks with a space
  .Text = "([!^13^l])([^13^l])([!^13^l])"
  .Replacement.Text = "\1 \3"
  .Execute Replace:=wdReplaceAll
  'Replace all double spaces with single spaces
  StrFnd = "[^s ]{2,}"
  'Edit StrFnd as needed for internationalisation issues
  If Application.International(wdListSeparator) = ";" Then
    StrFnd = Replace(StrFnd, ",", ";")
  End If
  .Text = StrFnd
  .Replacement.Text = " "
  .Execute Replace:=wdReplaceAll
  'Delete hypens in hyphenated text formerly split across lines
  StrFnd = "([a-z])-[^s ]{1,}([a-z])"
  'Edit StrFnd as needed for internationalisation issues
  If Application.International(wdListSeparator) = ";" Then
    StrFnd = Replace(StrFnd, ",", ";")
  End If
  .Text = StrFnd
  .Replacement.Text = "\1\2"
  .Execute Replace:=wdReplaceAll
  'Limit paragraph breaks and line breaks to one paragraph break per 'real' paragraph.
  StrFnd = "[^13^l]{1,}"
  'Edit StrFnd as needed for internationalisation issues
  If Application.International(wdListSeparator) = ";" Then
    StrFnd = Replace(StrFnd, ",", ";")
  End If
  .Text = StrFnd
  .Replacement.Text = "^p"
  .Execute Replace:=wdReplaceAll
End With
'Restore Screen Updating
Application.ScreenUpdating = True
End Sub