Sub Макрос2()
    Dim rng As Range
    Dim c As Long, i As Long
    'находим слово "ИНН"
    Set rng = ActiveSheet.Cells.Find(What:="ИНН", LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
    c = rng.Column 'определяем столбец
    'определяем первую объединёную ячейку
    Do Until Cells(rng.Row, c).MergeCells
        c = c +  1 
    Loop
    'устанавливаем ссылку на объединенную ячейку
    Set rng = ActiveSheet.Range(Cells(rng.Row, c).MergeArea.Address)
    rng = i ' заполняем
    Do Until Not rng.MergeCells
        'устанавливаем ссылку на следующую объединенную ячейку
        Set rng = ActiveSheet.Range(rng.Offset( 0 ,  1 ).MergeArea.Address)
        rng = i +  1  ' заполняем
        i = i +  1 
    Loop
End Sub

c = rng.Column 'определяем столбец