I would split by the decimal and then join it all back together again using left and right:
Sub Test()
    Dim rRng As Range, rCell As Range, rVar As Variant, r As String
    
    Set rRng = Sheets("Sheet3").Range("B3:N27")
    
    For Each rCell In rRng
        rVar = Split(rCell, ".")
        r = rVar(1)
        rCell = rVar(0) & "." & Left(r, 1) & " (" & Right(r, Len(r) - 1) & ")"
    Next rCell
End Sub