Sub test()
k = 2
i = 1
For p = 2 To 10 'строки
i = i + 1 'так перебираю строки, не стал использовать цикл, так как каждый раз приходится возвращаться ко второй строке
    For j = 2 To 10 'так перебираю столбцы
        If Cells(1, k) = Cells(i, j) Then 'ищу искомое значение в строках ниже, перебирая столбцы
            Cells(s, 2) = Cells(1, k) 'Если нашёл - выписываю
        End If
        If i = 5 Then 'Если дошёл до конца строк, сбрасываю счётчик и снова перехожу ко 2-ой строке
        i = 1
        End If
    Next j
    k = k + 1
Next p
End Sub