Bonsoir Damsa17, DjiDji59430, le forum,
Quelqu'un aurait une autre solution que par Power query
Un essai............
CTRL + E pour exécuter la macro...
Option Explicit
Dim source As Worksheet, dest As Worksheet, dico, c
Dim i As Long, j As Integer, dl As Long, dc As Integer
Dim resultat, msg As String
Sub Résultat()
Set source = Sheets("Feuil1")
Set dest = Sheets("test")
Set dico = CreateObject("Scripting.Dictionary")
dl = source.UsedRange.Rows.Count
dc = source.UsedRange.Columns.Count
Application.ScreenUpdating = False
dest.Cells.Delete
With source
For Each c In .Range(.Cells(2, 2), .Cells(dl, dc))
If c <> "" Then dico(c.Value) = ""
Next c
dest.Range("A2").Resize(dico.Count, 1) = Application.transpose(dico.keys)
End With
For i = 1 To dest.Range("A" & Rows.Count).End(xlUp).Row
For j = 1 To source.Cells(1, Cells.Columns.Count).End(xlToLeft).Column
If dest.Cells(i, 1) <> "" Then
Set resultat = source.Columns(j).Find(What:=dest.Cells(i, 1))
If Not resultat Is Nothing Then msg = msg & source.Cells(1, j) & " "
End If
Next j
dest.Cells(i, 2) = msg: dest.Columns(2).AutoFit
msg = ""
Next i
End Sub
Cordialement