Untitled

Sub Test()
    Dim ws As Worksheet
    Dim rCell As Range
    
    Dim wsName As String
    Dim doWyszukania As String
    
    'Tutaj musisz wpisac nazwe twojej zakłądki
    wsName = "Arkusz1"
    doWyszukania = "Kamila"
    
    Set ws = ThisWorkbook.Worksheets(wsName)
        
        
    For Each rCell In ws.UsedRange.Cells
        StartChar = InStr(1, rCell.Value, doWyszukania)
        If StartChar <> 0 Then
            rCell.Characters(Start:=StartChar, Length:=Len(doWyszukania)).Font.Bold = True
            rCell.Characters(Start:=StartChar, Length:=Len(doWyszukania)).Font.Underline = xlUnderlineStyleSingle
        End If
        
    Next
    
End Sub