[RESOLU] : Repertoire a essayer

T = Feuil1.Range("a2:h" & Feuil1.Cells(Rows.Count, 1).End(3).Row): C1.List = T

Private Sub listbox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 If listbox1.ListIndex < 0 Then Exit Sub
 For y = 1 To 8: Controls("Tb" & y) = listbox1.List(listbox1.ListIndex, y - 1): Next y
 Frame1.Visible = 1
End Sub

Option Compare Text
Dim T1(), T(), x As Long, i As Long, y As Long, z As Long, w As Long, c As Byte, r As Byte, b As Byte, a As Variant
Private Sub UserForm_Initialize()
  T = Feuil2.Range("c9:n" & Feuil2.Cells(Rows.Count, 3).End(3).Row): listbox1.List = T
  liste_Click
End Sub
Private Sub liste_Click()
  b = 1
    T = Feuil2.Range("c9:n" & Feuil2.Cells(Rows.Count, 3).End(3).Row): C1.List = T
  Label4.Caption = "Nb... " & listbox1.ListCount: es
End Sub
Private Sub C1_Click()
 c = 1: est
End Sub
Private Sub x1_Change()
 c = 2: If x1 <> "" Then est Else esv
End Sub
Private Sub listbox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 'If listbox1.ListIndex < 1 Then Exit Sub
 For y = 1 To 12: Me("Tb" & y) = listbox1.List(listbox1.ListIndex, y - 1): Next y
 Frame1.Visible = 1
End Sub
Private Sub fermer_Click()
 Unload Me
End Sub
Private Sub Suppr_Click()
 If b = 1 Then a = listbox1.ListIndex + 12 Else a = listbox1.List(listbox1.ListIndex, 8)
 Feuil1.Rows(a).Delete: esv
End Sub
Private Sub nouv_Click()
 For y = 1 To 12
 If Me("Tb" & y) = "" And y <> 8 Then MsgBox "Attention renseignement vide !!": Exit Sub
 Next y
 For y = 1 To 12: Feuil1.Cells(listbox1.ListCount + 12, y + 2) = Me("Tb" & y).Value: Next y
 esv
End Sub
Private Sub Modif_Click()
 For y = 1 To 12
 If Me("Tb" & y) = "" And y <> 8 Then MsgBox "Attention renseignement vide !!": Exit Sub
 Next y
 If b = 1 Then a = listbox1.ListIndex + 12 Else a = listbox1.List(listbox1.ListIndex, 12)
 For y = 1 To 12: Feuil1.Cells(a, y + 2) = Me("Tb" & y).Value: Next y
 esv
End Sub
Sub es()
 Frame1.Visible = 0
 For y = 1 To 12: Me("Tb" & y).Value = "": Next y
 End Sub
Sub esv()
 For y = 1 To 12: Me("Tb" & y).Value = "": Next y
 UserForm_Initialize
liste_Click:      listbox1 = "": listbox1.ListIndex = 0: x1 = ""
 Label4.Caption = "Nb... " & listbox1.ListCount
 Frame1.Visible = 0
End Sub
Sub est()
  On Error Resume Next
  For y = 1 To 3
  If Me("O" & y) Then r = Me("O" & y).Tag
  Next y
  b = 2
  T = Feuil2.Range("c9:n" & Feuil1.Cells(Rows.Count, 3).End(3).Row).Value
  x = 1: w = 8
  If c = 1 Then
  For i = 1 To UBound(T)
  w = w + 1
  If T(i, 1) = C1.Text Then
  T(i, 12) = w
  ReDim Preserve T1(1 To 12, 1 To x)
  For k = 1 To 12
  T1(k, x) = T(i, k)
  Next k: x = x + 1: End If: Next i
  Else
  For i = 1 To UBound(T)
  w = w + 1
  If Left(T(i, r), Len(x1)) = Left(x1, Len(x1)) Then
  T(i, 12) = w
  ReDim Preserve T1(1 To 12, 1 To x)
  For k = 1 To 12
  T1(k, x) = T(i, k)
  Next k: x = x + 1: End If: Next i
  End If
  listbox1.Column = T1
  Label4.Caption = "Nb... " & listbox1.ListCount
  Erase T, T1
  es
 End Sub
Private Sub Tb3_keyPress(ByVal keyAscii As MSForms.ReturnInteger)
 If InStr("0123456789 ", Chr(keyAscii)) = 0 Then keyAscii = 0
End Sub
Private Sub Tb4_keyPress(ByVal keyAscii As MSForms.ReturnInteger)
 If InStr("0123456789 ", Chr(keyAscii)) = 0 Then keyAscii = 0
End Sub
Private Sub Tb7_keyPress(ByVal keyAscii As MSForms.ReturnInteger)
 If InStr("0123456789", Chr(keyAscii)) = 0 Then keyAscii = 0
End Sub
Private Sub Reset_Click()
 Unload Me: Clients.Show
End Sub