YT_Match In Merged Cells By MergeArea YasserKhalil

https://www.youtube.com/watch?v=1g1bPYC4V-A
-------------------------------------------

Sub Match_In_Merged_Cells_By_MergeArea_YasserKhalil()
    Dim x, r As Range, c As Range, lr As Long
    Const iRow As Integer = 4

    lr = Cells(Rows.Count, 1).End(xlUp)(2).Row
    x = Application.Match(Range("G2").Value, Rows(iRow), 0)

    If Not IsError(x) Then
        Set r = Cells(iRow + 1, x).Resize(, Cells(iRow + 1, x).Offset(-1).MergeArea.Count)
        For Each c In r
            If c.Value = Range("F2").Value Then
                Cells(lr, 1).Value = Range("C2").Value
                Cells(lr, 2).Value = Range("D2").Value
                Cells(lr, c.Column).Value = Range("E2").Value
                Exit For
            End If
        Next c
    End If
End Sub