Sub RechecheMlt()
Dim ValeurCherchée As String, MatriceCherche As New Collection, MatriceTrouve As New Collection, Ligne As Long
Dim c As String, i As Long, Z As Long, ColonneCherche As String, ColonneTrouve As String, LastLigne As Long
Dim ColonneRésultat As String, Maj As Boolean, RepMaj As Integer
ValeurCherchée = InputBox('Valeur cherchée')
If ValeurCherchée = '' Then Exit Sub
ColonneCherche = InputBox('Colonne où il faut chercher cette valeur', 'Entrée', 'A')
If ColonneCherche = '' Then Exit Sub
ColonneTrouve = InputBox('Colonne contenant les résultat à renvoyer', 'Entrée', 'B')
If ColonneTrouve = '' Then Exit Sub
ColonneRésultat = InputBox('Colonne ou mettre les valeurs correspondantes', 'Entrée', 'C')
If ColonneRésultat = '' Then Exit Sub
RepMaj = MsgBox('Respectez la casse de ' & ValeurCherchée & ' ?', 4, 'Entrée')
Maj = IIf(RepMaj = 6, True, False)
ValeurCherchée = IIf(Maj, ValeurCherchée, UCase(ValeurCherchée))
LastLigne = Range(ColonneCherche & '1').End(xlDown).Row
On Error GoTo Erreur
For Z = 1 To LastLigne
MatriceCherche.Add Range(ColonneCherche & Z).Value
MatriceTrouve.Add Range(ColonneTrouve & Z).Value
Next Z
For i = 1 To MatriceCherche.Count
c = IIf(Maj, MatriceCherche(i), UCase(MatriceCherche(i)))
If ValeurCherchée = c Then
Ligne = Ligne + 1
Range(ColonneRésultat & Ligne) = MatriceTrouve(i)
End If
Next i
Exit Sub
Erreur:
MsgBox Error & ' c'est certainement le nom des colonnes, entrez uniquement la lettre ...'
End Sub