Option Explicit
Sub test()
Dim a, i As Long, j As Long, w(), dico As Object, txt As String
Set dico = CreateObject("Scripting.Dictionary")
a = Sheets("Champagne").Range("a1").CurrentRegion.Value
For i = 2 To UBound(a, 1) - 1
dico.Item(a(i, 2)) = VBA.Array(True, Empty)
Next
a = Sheets("water").Range("a1").CurrentRegion.Value
For i = 2 To UBound(a, 1) - 1
If dico.exists(a(i, 2)) Then
w = dico.Item(a(i, 2))
w(1) = a(i, 1)
dico.Item(a(i, 2)) = w
Else
dico.Item(a(i, 2)) = VBA.Array(False, a(i, 1))
End If
Next
Application.ScreenUpdating = False
'Initialiser
With Sheets("GENERAL").Range("L10:AA" & Range("L" & Rows.Count).End(xlUp).Row)
a = .Value
For i = 1 To UBound(a, 1) Step 2
For j = 1 To UBound(a, 2)
txt = CStr(a(i + 1, j))
If dico.exists(txt) Then
If dico.Item(txt)(0) = True Then
.Cells(i + 1, j).Interior.ColorIndex = 15
End If
If Not IsEmpty(dico.Item(txt)(1)) Then
.Cells(i, j).Value = dico.Item(txt)(1)
End If
End If
Next
Next
End With
Application.ScreenUpdating = True
End Sub