Sub mrshkei()
Dim r As Long, r2 As Long, c As Long, c2 As Long, lr As Long, cell As Range
k = 2
For r = 5 To 13
    For c = 2 To 13
        If Cells(r, c) <> "" Then
            For r2 = 4 To 5
                For c2 = 18 To 30
                If Cells(r2, c2) = Cells(2, 2) Then
                Set cell = Range(Cells(6, c2), Cells(9, c2)).Find(Cells(r, c), LookIn:=xlValues, LookAt:=xlWhole)
                If Not cell Is Nothing Then
                    Cells(k, 32) = Cells(2, 2)
                    Cells(k, 33) = Cells(4, c)
                    Cells(k, 34) = Cells(r, 1)
                    Cells(k, 35) = Cells(3, c2)
                    Cells(k, 36) = Cells(r, c)
                    k = k + 1
                    GoTo GGG
                End If
                End If
                Next c2
            Next r2
        End If
GGG:
    Next c
Next r
End Sub