Option Explicit
Sub Ventile()
Dim a, i As Long, j As Long
Dim ws As Worksheet, dico As Object
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
a = Sheets("Global").[a1].CurrentRegion.Value
For i = 2 To UBound(a, 1)
Set dico(a(i, 1)) = CreateObject("Scripting.Dictionary")
dico(a(i, 1)).CompareMode = 1
For j = 4 To UBound(a, 2)
If a(i, j) <> "" Then dico(a(i, 1))(a(1, j)) = a(i, j)
Next
Next
Application.ScreenUpdating = False
For Each ws In Worksheets
If dico.exists(ws.Name) Then
With ws.Range("a3").CurrentRegion
.Columns(2).ClearContents
For i = 1 To .Rows.Count
If dico(ws.Name).exists(.Cells(i, 1).Value) Then
.Cells(i, 2).Value = dico(ws.Name)(.Cells(i, 1).Value)
End If
Next
End With
End If
Next
Application.ScreenUpdating = True
End Sub