Sub TransferFootNotes()
Application.ScreenUpdating = False
Dim i As Long, Rng As Range
With ActiveDocument
  For i = 201 To .Footnotes.Count
    Set Rng = .Footnotes(i).Range
    .Footnotes(i - 1).Range.FormattedText = Rng.FormattedText
  Next
  .Footnotes(.Footnotes.Count).Delete
End With
Application.ScreenUpdating = True
End Sub