Sub Demo()
Application.ScreenUpdating = False
Dim wdPage As Page, wdRct As Rectangle, wdRng As Range, wdLine As Line
For Each wdPage In ActiveDocument.ActiveWindow.Panes(1).Pages
  For Each wdRct In wdPage.Rectangles
    For Each wdLine In wdRct.Lines
      Set wdRng = wdLine.Range
      With wdRng
        If .Characters.Last.Text Like "[–—]" Then
          .MoveEndUntil Cset:=" ", Count:=wdBackward
          .InsertAfter Chr(11)
        End If
      End With
    Next
  Next
Next
Application.ScreenUpdating = True
End Sub