Sub Копировать_изменить_формулу()
    Dim cs As Range, cr As Range, sf As String, sb As String
    For Each cs In Intersect(Selection, ActiveSheet.UsedRange).Columns(1).Cells
        For Each cr In Intersect(Selection, cs.Cells(1, 2).Resize(1, Selection.Columns.Count)).Cells
            sf = cs.Formula
            sf = Replace(sf, "!" & cs.EntireColumn.Cells(2, 1).Value, "!" & cr.EntireColumn.Cells(2, 1).Value)
            On Error Resume Next
            cr.Formula = sf
            On Error GoTo 0
        Next
    Next
End Sub