Szia,

Kijelölt cellákon csinálja meg:

Sub Makró3()

Dim i As Integer
Dim c As Range

For Each c In Selection.Cells
i = 1
Do
c.Characters(i, 1).Font.FontStyle = "Félkövér"
i = i + 1
Loop Until c.Characters(i, 1).Text = Chr(10) Or i > c.Characters.Count
Next c

End Sub