Sub AddLetterHeads()
  Dim iPar As Integer, sLett As String, aRng As Range, sPrev As String
  Set aRng = ActiveDocument.Range
  For iPar = aRng.Paragraphs.Count To 1 Step -1
    sLett = aRng.Paragraphs(iPar).Range.Characters(1)
    If iPar > 1 Then sPrev = aRng.Paragraphs(iPar).Previous.Range.Characters(1)
    If sPrev <> sLett Or iPar = 1 Then
      aRng.Paragraphs(iPar).Range.InsertBefore sLett & vbCr
      aRng.Paragraphs(iPar).Style = "BibloChar"   'the new paragraph
    End If
  Next iPar
End Sub