Sub FormatAuthorNamesInSmallCaps()

Dim rng As Range
Dim authorNames As Variant
Dim footnote As Footnote

Application.ScreenUpdating = False
    Set rng = ActiveDocument.Range

    'Liste der Autorennamen
    authorNames = Array("Ackermann", "Angermann", _
    "Andersen", "Atzeni", "Baecker", "Ortmann", _
    "Zamoyski", "Ziegler", "Wurzbach", "Zittel", _
    "Zürcher", "Zytphen-Adeler")

    ' Formatierung im Haupttextkörper
    For i = 0 To UBound(authorNames)
        Call FormatRange(rng, authorNames(i))
    Next i

    ' Formatierung in den Fußnoten
    For Each footnote In ActiveDocument.Footnotes
        Set rng = footnote.Range
        For i = 0 To UBound(authorNames)
            Call FormatRange(rng, authorNames(i))
        Next i
    Next footnote

Application.ScreenUpdating = True
End Sub

' Hilfsfunktion zur Formatierung eines Bereichs
Sub FormatRange(ByRef rng As Range, ByVal searchText As String)
    With rng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = searchText
        .Forward = True
        .Wrap = wdFindStop
        .MatchWholeWord = True
        While .Execute
            rng.Font.Italic = True
            rng.Font.SmallCaps = True
            rng.Collapse wdCollapseEnd
        Wend
    End With
End Sub