Code ne renvoi pas bonnes valeurs

Sub Valider_Click() 'OK
     Application.ScreenUpdating = False
'Transfére des données ListBox dans la Feuille Perso
Application.ScreenUpdating = False
Dim f As Worksheet
Dim R As Range
Dim c As Range
Dim a As String
Dim l As Long

    If IsNull(ListBox2.Value) Then MsgBox "Vous devez effectuer une selection !", vbCritical + vbOKOnly, " Aucun contact sélectionné": Exit Sub

  'Chercher le nom et le prénom dans la base de données
  With Worksheets("Base")
     Set R = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
  End With
  Set c = R.Find(What:=ListBox2.Value, LookIn:=xlValues, lookat:=xlWhole)
    'If Not c Is Nothing Then a = c.Address
   
   
   'N° de la ligne dans Base (=rang de l'item choisi dans Combobox +2)
   l = ListBox2.ListIndex + 2

    
    'Do While Not c Is Nothing
  'Vérifier le prénom
   'If c.Offset(0, 1).Value = ListBox2.List(ListBox2.ListIndex, 1) Then Exit Do
   ' Set c = R.FindNext
   ' If c.Address = a Then Set c = Nothing
    'Loop
  'Transférer les données
  With Worksheets("Perso")
  'Nom
  [A9].Value = ListBox2.List(ListBox2.ListIndex, 0)
  'Prénom
  [B9].Value = ListBox2.List(ListBox2.ListIndex, 1)
    If Not c Is Nothing Then
  'Date naissance
  [A12].NumberFormat = "dd/mm/yyyy"
  [A12].Value = Sheets("Base").Range("C" & l)
  'Commune
  [B12].Value = Sheets("Base").Range("D" & l)
  'Dpt
  [C12].Value = Sheets("Base").Range("E" & l)
  'Adresse
  [A15].Value = Sheets("Base").Range("j" & l)
  'Complément
  [B15].Value = Sheets("Base").Range("k" & l)
  'CP
  [C15].Value = Sheets("Base").Range("l" & l)
  'Commune
  [D15].Value = Sheets("Base").Range("m" & l)
  'Tel
  [A18].Value = Sheets("Base").Range("F" & l)
  [B18].Value = Sheets("Base").Range("G" & l)
  End If
  End With
  Ecrire
Application.ScreenUpdating = True
End Sub

Sub Ecrire() 'OK
Application.ScreenUpdating = False
'    Sheets("EC").Select
    [B1] = "ASSOCIATION AIDE PERSONNES"
    [B2] = "en DIFFICULTES"
    [B1:B2].Select
    Selection.Font.Bold = True
       With Selection.Font
            .Name = "Times New Roman"
            .Size = 16
        End With
    [B1:E2].Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
    End With
    
    [B5] = "Renseignements concernant :"
    [B5].Select
    Selection.Font.Bold = True
    
       With Selection.Font
        .Name = "Times New Roman"
        .Size = 14
       End With

     [B5].Select
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .ReadingOrder = xlContext
        End With
        
'        [B5:E5].Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
    End With
        
      [A8] = "Nom :"
      [B8] = "Prénom :"
    [A11] = "Né(e) le :"
    [B11] = "Commune :"
    [C11] = "Dpt ou CP :"
    [A14] = "Demeurant :"
    [B14] = "Complément adresse :"
    [C14] = "CP :"
    [D14] = "Commune :"
    [A17] = "Téléphone Fixe :"
    [B17] = "Téléphone Portable :"
    
    [A8:B8,A11:C11,A14:D14,A17:B17].Select
    With Selection.Font
        .Name = "Times New Roman"
        .Size = 8
    End With
    Selection.Font.Italic = True
      [a1].Select
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E5")) Is Nothing Then 'mettre après then le nom de la macro à executer
End Sub