J'ai trouvé ceci avec la méthode Find pour rchercher le nom de la ligne à sélectionner
Dim nom
Private Sub CodeList_Click()
Range("Feuil1!A2").Select
ActiveCell.Offset(CodeList.ListIndex, 0).Select
ChercheInput
'-- transfert Base de Données --> Formulaire
Code = ActiveCell.Offset(0, 0).Value
Etb = ActiveCell.Offset(0, 1).Value
AUTRE1 = ActiveCell.Offset(0, 2).Value
AUTRE2 = ActiveCell.Offset(0, 3).Value
AUTRE3 = ActiveCell.Offset(0, 4).Value
AUTRE4 = ActiveCell.Offset(0, 5).Value
AUTRE5 = ActiveCell.Offset(0, 6).Value
AUTRE6 = ActiveCell.Offset(0, 7).Value
AUTRE7 = ActiveCell.Offset(0, 8).Value
End Sub
Private Sub Save_Click()
If Recherche.Value = "" Then
MsgBox "Veuillez effectuer une recherche avant de mettre à jour les données", vbInformation
Recherche.SetFocus
Else
Range("Feuil1!A4").Select
ActiveCell.Offset(Recherche.ListIndex, 0).Select
ActiveCell.Offset(0, 0).Value = Code
ActiveCell.Offset(0, 1).Value = Etb
ActiveCell.Offset(0, 2).Value = AUTRE1
ActiveCell.Offset(0, 3).Value = AUTRE2
ActiveCell.Offset(0, 4).Value = AUTRE3
ActiveCell.Offset(0, 5).Value = AUTRE4
ActiveCell.Offset(0, 6).Value = AUTRE5
ActiveCell.Offset(0, 7).Value = AUTRE6
ActiveCell.Offset(0, 8).Value = AUTRE7
End If
End Sub
Private Sub Update_Click()
[A65000].End(xlUp).Offset(1, 0).Select
'--- Transfert Formulaire dans BD
ActiveCell.Offset(0, 0).Value = Me.Code
ActiveCell.Offset(0, 1).Value = Me.Etb
ActiveCell.Offset(0, 2).Value = Me.AUTRE1
ActiveCell.Offset(0, 2).Value = Me.AUTRE2
ActiveCell.Offset(0, 2).Value = Me.AUTRE3
ActiveCell.Offset(0, 2).Value = Me.AUTRE4
ActiveCell.Offset(0, 2).Value = Me.AUTRE5
ActiveCell.Offset(0, 2).Value = Me.AUTRE6
ActiveCell.Offset(0, 2).Value = Me.AUTRE7
End Sub
Private Sub UserForm_Initialize()
Dim i As Integer
For i = 1 To 11
Me.Controls("Label" & i).ForeColor = RGB(227, 27, 35) 'Défini la couleur de la police des champs Label
Next
Me.Save.ForeColor = RGB(227, 27, 35) 'Défini la couleur de la police du bouton valider
Me.Update.ForeColor = RGB(227, 27, 35) 'Défini la couleur de la police du bouton mettre à jour
Me.Recherche.List = SansDoublonsTrié(Range([A2], [A65000].End(xlUp))) 'Filtrer les codes sans doublons
End Sub
Private Sub Recherche_Change() 'au changement dans la combobox "Recherche"
Dim cel As Range 'déclare la variable cel (CELlule)
nom = Recherche.Value
ChercheCell
Me.CodeList.Clear 'vide la listbox "CodeList"
'boucle sur toutes les cellules éditées cel de la colonne A de l'onglet "Feuil1"
For Each cel In Sheets("Feuil1").Range("A2:A" & Sheets("Feuil1").Cells(Application.Rows.Count, 1).End(xlUp).Row)
'condition : si la valeur de la cellule (convertie en texte) est égale à la valeur de la combobox "Recherche"
If CStr(cel.Value) = Me.Recherche.Value Then
Me.CodeList.AddItem cel.Value 'ajoute la valeur de la cellule dans la première colonne de la listbox (colonne 0)
With Me.CodeList 'prend en compte la listbox "CodeList"
.List(.ListCount - 1, 1) = cel.Offset(0, 1).Value 'ajoute la valeur de la cellule décalée d'une colonne dans la seconde colonne
.List(.ListCount - 1, 2) = cel.Offset(0, 2).Value 'ajoute la valeur de la cellule décalée de deux colonnes dans la troisième colonne
.List(.ListCount - 1, 3) = cel.Offset(0, 2).Value 'ajoute la valeur de la cellule décalée de deux colonnes dans la quatrième colonne
.List(.ListCount - 1, 4) = cel.Offset(0, 2).Value 'ajoute la valeur de la cellule décalée de deux colonnes dans la cinquième colonne
.List(.ListCount - 1, 5) = cel.Offset(0, 2).Value 'ajoute la valeur de la cellule décalée de deux colonnes dans la sixième colonne
.List(.ListCount - 1, 6) = cel.Offset(0, 2).Value 'ajoute la valeur de la cellule décalée de deux colonnes dans la septième colonne
.List(.ListCount - 1, 7) = cel.Offset(0, 2).Value 'ajoute la valeur de la cellule décalée de deux colonnes dans la huitième colonne
End With 'fin de la prise en compte de la listbox "CodeList"
End If 'fin de la condition
Next cel 'prochaine cellule cel de la boucle
End Sub
'1- à partir d'une saisie dans une inputbox
Sub ChercheInput()
'à partir d'une saisie dans une inputbox, donc d'une chaîne,
'cette procédure permet à la méthode Find de réussir avec tous
'types de données (texte, nombres entiers et décimaux, dates)
'grâce au transtypage avec CDate des chaînes qui peuvent être
'lues comme des dates
Dim plage As Range, valeur
Set plage = Range("A:A")
valeur = InputBox("Valeur à chercher :")
If valeur = "" Then Exit Sub
If InStr(1, valeur, _
Application.International(xlDateSeparator)) > 0 Then
valeur = CDate(valeur)
End If
plage.Find(valeur).Select
End Sub 'fs
'2- à partir de la valeur d'une cellule
Sub ChercheCell()
'à partir de la valeur d'une cellule
'le passage de cette valeur avec la méthode Evaluate ([])
'permet à Find de réussir avec tous types de données (y compris les dates)
Dim plage As Range
Set plage = Range("A:A")
plage.Find([nom]).Select
End Sub
Tu l'adapteras suivant tes besoins
@+Le Pivert