If Then Inserir Células

Resolvendo o problema

1. Comece declarando as variáveis e encontrando o último dado da planilha. Como será inserida uma linha para cada letra, somamos a variável última linha ao total letras do alfabeto (26).

   Dim UltLinhas As Long
   Dim i As Integer
   
   UltLinha = Cells(Rows.Count, 1).End(xlUp).Row
   UltLinha = UltLinha + 26
   

2. Crie o loop For Next com uma condicional If para o diferenciar a primeira letra do nome entre as linhas. Depois basta inserir uma linha na divisória e preenche-la da cor desejada.

   For i = 18 To UltLinha          
       If Left(Cells(i, 1), 1) <> Left(Cells(i + 1, 1), 1) Then
           Range(Cells(i + 1, 1), Cells(i + 1, 3)).Insert shift:=xlDown
   
           With Range(Cells(i + 1, 1), Cells(i + 1, 3))
               .Interior.Color = RGB(140, 198, 63)
               .Borders.LineStyle = xlContinuous
               .Borders.Color = RGB(255, 255, 255)
               .Borders.Weight = xlMedium
           End With
   
       i = i + 1
       End If
   Next i
   

Código Consolidado

    Sub Resolucao()

    Dim UltLinhas As Long
    Dim i As Integer

    UltLinha = Cells(Rows.Count, 1).End(xlUp).Row
    UltLinha = UltLinha + 27 'Mais o número de letras do alfabeto

    For i = 18 To UltLinha

        'Para prevenir que o código execute mais de uma vez
        If Cells(i + 1, 2).Interior.Color = RGB(140, 198, 63) Then
            Exit Sub
        End If

        If Left(Cells(i, 1), 1) <> Left(Cells(i + 1, 1), 1) Then
            Range(Cells(i + 1, 1), Cells(i + 1, 3)).Insert shift:=xlDown

            With Range(Cells(i + 1, 1), Cells(i + 1, 3))
                .Interior.Color = RGB(140, 198, 63)
                .Borders.LineStyle = xlContinuous
                .Borders.Color = RGB(255, 255, 255)
                .Borders.Weight = xlMedium
            End With

        i = i + 1
        End If

    Next i

    End Sub