Ændrer formatering af ET ord i en sætning, via replace applicationen

Hej eksperter,

Jeg har lavet en lille kode, som gennemsøger et output ark for ord der er listet i et input ark.

Alle de fundne ord skal erstattes af samme ord, men med kursiv format, sådan at jeg sikrer, at alle forekomster af dette ord er skrevet med kursiv.

Problem: replace applicationen ændrer formattet på hele cellen og ikke kun på det pågældende ord.

Følgende ark er nødvendige:
1) input (indeholder liste af ord som der søges efter)
2) output (indeholder en masse tekst, hvori der søges og erstattes)

*** KODE ***

Sub autoKursiv()

Dim forkortelse As String
Dim examinedRow As Integer

examinedRow = 0

Worksheets("input").Select
Range("A1").Select

Do
    examinedRow = examinedRow + 1
    ActiveCell.Offset(1, 0).Select
    forkortelse = ActiveCell.Value
   
    Worksheets("output").Select
    Cells.Select
   
    With Application.ReplaceFormat.Font
        .FontStyle = "Kursiv"
        .Subscript = False
        .TintAndShade = 0
    End With
    Cells.Replace What:=forkortelse, Replacement:=forkortelse, LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=True
         
    Worksheets("status").Select
    Range("A1").Offset(examinedRow, 0).Select
       
Loop Until IsEmpty(ActiveCell.Offset(1, 0))

End Sub

*** END KODE ***

Spørgsmål: Hvad gør jeg forkert?

Med venlig hilsen
NPNG