Sub Test()
Dim Erste As Long, Letzte As Long, Start As Long, Ende As Long, Text As String
With ActiveDocument.Range.Find
.Text = "("
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do
.Execute
Start = .Parent.Start
If Start = Erste Or Start = Letzte Then Exit Do
If Erste = 0 Then Erste = Start
Letzte = Start
Ende = InStr(Start, ActiveDocument.Range.Text, ")")
Text = ActiveDocument.Range(Start + 1, Ende - 1)
ActiveDocument.Range(Start, Ende).Delete
ActiveDocument.Footnotes.Add ActiveDocument.Range(Start, Start), Text:=Text
Loop
End With
End Sub