Maybe :
Sub Test()
Dim a, b, c As New Collection, i As Long, j As Long, p As Long
With Sheets("VBA FOR INDEX MATCH IN COL D")
a = .Range("I1:M" & .Cells(.Rows.Count, "I").End(xlUp).Row).Value
b = .Range("C1:G" & .Cells(.Rows.Count, "C").End(xlUp).Row).Value
For i = 2 To UBound(a, 2)
For j = 2 To UBound(b, 2)
If a(1, i) = b(1, j) Then a(1, i) = j: Exit For
Next j
If Val(a(1, i)) = 0 Then a(1, i) = Empty
Next i
For i = 2 To UBound(a, 1)
On Error Resume Next
c.Add key:=a(i, 1), Item:=i
On Error GoTo 0
Next i
For i = 2 To UBound(b, 1)
p = 0
On Error Resume Next
p = c(b(i, 1))
On Error GoTo 0
If p > 0 Then
For j = 2 To UBound(b, 2)
If Not IsEmpty(a(1, j)) Then b(i, j) = a(p, a(1, j))
Next j
End If
Next i
.Range("C1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End With
End Sub
Bookmarks