Bonjour,
Une proposition à tester.
Option Explicit
Option Private Module
Public Sub RechercheOutils()
Dim wss As Worksheet, wsd As Worksheet
Dim lngRow As Long, d As Long
Dim iCol As Integer, i As Integer
Dim rng As Range, c As Range
Dim myArray
Application.ScreenUpdating = False
Set wss = Worksheets("Données")
Set wsd = Worksheets("Recherche")
With wsd
If .[A2] = Empty Then Exit Sub
.Range("C2:C" & .Range("C2").End(xlDown).Row).ClearContents
End With
With wss
lngRow = .Range("A" & Rows.Count).End(xlUp).Row
iCol = .Cells(1, Columns.Count).End(xlToLeft).Column
Set rng = .Range(.Cells(1, 1), .Cells(lngRow, iCol))
Set myArray = CreateObject("Scripting.Dictionary")
Set c = rng.Find(what:=wsd.[A2], LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
d = c.Row
End If
For i = 2 To iCol
If Not IsEmpty(.Cells(d, i)) Then myArray(.Cells(1, i).Value) = ""
Next
End With
With wsd
.[C2].Resize(myArray.Count, 1) = Application.Transpose(myArray.keys)
End With
Set wss = Nothing: Set wsd = Nothing: Set rng = Nothing: Set myArray = Nothing
End Sub