For j = Workprice_Col_1.Column + 1 To Workprice_Col_3.Column - (Workprice_Col_2.Column + 1)       ' определяем диапазон столбцов массива
       For i = 5 To Workprice_LastRow                                                                 ' определеяем диапазон строк массива
           Set iVal = Sheets("Dealprice").Range(Cells(i, WP_Pos.Column))
           Find_Range_DPO = Sheets("Dealprice_Old").Range(Cells(5, DPO_Pos.Column), Cells(DealpriceOld_LastRow, DPO_Pos.Column))  ' определяем диапазон поиска по столбцу "Работа расценка" в архивном прайсе "Сделка"
           Set x = Find_Range_DPO.Find(What:=iVal.Value, LookIn:=xlValues, lookAt:=xlWhole)                 ' находим искомую ячейку на листе Dealprice_Old
           Find_Range_WP = Sheets("Workprice").Range(Cells(5, WP_Pos.Column), Cells(Workprice_LastRow, WP_Pos.Column))  ' определяем диапазон поиска по столбцу "Работа расценка" в прайсе "Работа"
           Set y = Find_Range_WP.Find(What:=iVal.Value, LookIn:=xlValues, lookAt:=xlWhole)                  ' находим искомую ячейку на листе Workprice
            If x.Offset(, j - DPO_Pos).Value <> "" And Not x.Offset(, j - DPO_Pos).Formula Like "=Workprice!*" Then ' смещаемся в нужную колонку и проверяем что ячейка не пустая и не содержит ссылку на Workprice
               Sheets("Dealprice").Cells(i, j) = x.Value                                                     ' вставляем значение в текущую ячейку на листе Dealprice
            ElseIf y.Offset(, j - WP_Pos).Value = "" Then                                                 ' проверяем является ли искомая ячейка на листе Workprice пустой
               Sheets("Dealprice").Cells(i, j) = ""                                                       ' ставим пустое значение в ячейке
            Else
               y.Copy                                                                                     ' копируем найденую ячейку на листе Workprice
               Sheets("Dealprice").Cells(i, j).Paste Link:=True                                           ' вставляем ссылку на ячейку с листа Workprice
            End If
           i = Workprice_LastRow + 1                                                      ' завершаем цикл строк если достигли последней
       Next i
           j = (Workprice_Col_3.Column - Workprice_Col_2.Column) + 1                      ' завершаем цикл столбцов если достигли последнего
    Next j

Sub КурсЕ()
'
' КурсЕ Макрос
' Добавление к цене переменной "КурсЕ"
'
' Сочетание клавиш: Ctrl+Е
'
    Dim xPrice As String
    xPrice = ActiveCell.Formula
            If ActiveCell.Formula Like "=*" Then
            ActiveCell.Formula = "=(" & Right(xPrice, Len(xPrice) - 1) & ")*курсЕ"
            Else
            ActiveCell.Formula = "=(" & xPrice & ")*курсЕ"
        End If
 End Sub

Dim xPrice
Set xPrice = ActiveCell
  ActiveCell.Formula = "=(" & xPrice & ")*курсЕ"