Une Majuscule en début de cellule pas plus.

Option Explicit

Sub Essai()
  Dim Tbl, n&: Application.ScreenUpdating = 0
  n = Cells(Rows.Count, 1).End(3).Row
  If n = 1 Then Exit Sub
  Dim chn$, k&, i&: n = n - 1: Tbl = [A2].Resize(n)
  For i = 1 To n
    chn = Tbl(i, 1): k = Len(chn)
    If k > 0 Then Tbl(i, 1) = _
      UCase$(Left$(chn, 1)) & Right$(chn, k - 1)
  Next i
  [A2].Resize(n) = Tbl
End Sub

Option Explicit
Sub MajusculePremiereLettre()
Dim Elem As Range, W As Variant
    Application.EnableEvents = False
        For Each Elem In Selection.Cells
            W = Split(Elem)
            W(0) = StrConv(W(0), vbProperCase)
            Elem = Join(W)
        Next
    Application.EnableEvents = False
    MsgBox ("Fin de traitement")
End Sub

Option Explicit
Sub MajusculePremiereLettre()
Dim Elem As Range, t$
    Application.EnableEvents = False
        For Each Elem In Selection.Cells
           t = Elem.Text: Mid(t, 1, 1) = UCase(Mid(t, 1, 1)): Elem = t
        Next
    Application.EnableEvents = False
    MsgBox ("Fin de traitement")
End Sub

]Option Explicit
Sub MajusculePremiereLettre()
Dim Elem As Range, W As Variant
    Application.EnableEvents = False
        For Each Elem In Selection.Cells
            If Elem <> "NC" then
                W = Split(Elem)
                W(0) = StrConv(W(0), vbProperCase)
                Elem = Join(W)
            End if
        Next
    Application.EnableEvents = False
    MsgBox ("Fin de traitement")
End Sub

For i = 1 To UBound(myArray, 1)
    myArray(i, 1) = UCase(Left(myArray(i, 1), 1)) & _
        Right(myArray(i, 1), Len(myArray(i, 1)) - 1)
Next

For i = 1 To UBound(myArray, 1)
    myArray(i, 1) = UCase(Left(myArray(i, 1), 1)) & Mid(myArray(i, 1), 2)
Next

For i = 1 To UBound(myArray, 1)
   t = myArray(i, 1): Mid(t, 1, 1) = UCase(Mid(t, 1, 1)): myArray(i, 1) = t
Next