Rechercher un critère et afficher un tableau

Bonjour,
J'ai le tableau suivant:
composant huile_1 huile_2 huile_3 huile_4 huile_5
molecule_1 0,05 0 3 2 3
molecule_2 1 2 5 7 3
molecule_3 14 0 0 0 0
molecule_4 0 3 6 0 3
molecule_5 0 0 0 0 0
molecule_6 5 4 2 0 3
molecule_7 5 0 0 3 34
molecule_8 5 0 0 0 0
molecule_9 5 0 9 3 23
molecule_10 5 0 9 0 0
molecule_11 5 0 0 3 0
molecule_12 5 0 12 0 0
molecule_13 5 0 0 0 0
molecule_14 0 5 1 0 4
molecule_15 0 5 0 3 0
molecule_16 0 5 0 1 0
molecule_17 6 5 18 5 5
molecule_18 0 5 0 0 0
molecule_19 16 5 0 5 6
molecule_20 0 0 0 0 0
molecule_21 10 40 0 0 0
molecule_22 0 5 30 23 6
molecule_23 0,95 0 0 34 5
molecule_24 0 4 0 0 0
molecule_25 12 4 5 5 0
molecule_26 0 0 0 6 5
molecule_27 0 8 0 0 0

Je souhaite créer une macro VBA qui m'affiche une fenêtre indiquant le nom de la molécule recherchée et qui afficherait au final le pourcentage de cette molécule dans chacune des huiles essentielles.
Pouvez-vous m'adier SVP!!!
J'ai débuté avec ceci mais je suis loin de la solution:

Sub Recherche2()

Dim xCellule As Range
Dim xSelection As String
Dim Message As String

'Crée une boîte de dialogue :
Message = InputBox(" Entrez le nom de la molécule : ", "Mon Programme", "01/mm/aaaa")

'Arrête procédure si utilisateur clique sur annuler
If Message = " " Then Exit Sub

'Place la valeur dans la cellule A1;
'Worksheets("feuil1").Range(" A1 ").Value = Message

'Sélectionner le tableau :
'sélectionner toutes les cellules du tableau :

Selection.Worksheet.UsedRange.Select

'activer la dernière cellule du tableau
Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count).Activate

'Recherche " Message " dans le tableau :

For Each xCellule In Selection
If xCellule.Value = Message Then
xSelection = xSelection & xCellule.Address & ","
End If
Next
If Len(xSelection) > 0 Then
Range(Left(xSelection, Len(xSelection) - 1)).Select
End If