Как функцией пользователя изменить значение другой ячейки

'---------------------------------------------------------------------------------------
' Author : Щербаков Дмитрий(The_Prist)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
' Procedure : ChangeAnotherCell
'             http://www.excel-vba.ru
' Purpose   : Функция меняет значение указанной ячейки
' Аргументы:
'    rCell  - ячейка, в которой необходимо поменять значение.
'    vVal   - значение для записи в ячейку rCell.
'             Произвольный текст или ссылка на ячейку.
'---------------------------------------------------------------------------------------
Function ChangeAnotherCell(rCell As Range, vVal) As String
    Application.Volatile
    With rCell
        If .Value = Empty Then
            .Replace Empty, vVal, 1, , 0
        Else
            .Replace .Value, vVal, 1, , 0
        End If
    End With
End Function

'---------------------------------------------------------------------------------------
' Author : Щербаков Дмитрий(The_Prist)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
' Procedure : ChangeAnotherCell
' Purpose   : Функция меняет значение и формат указанной ячейки
' Аргументы:
'    rCell        - ячейка, в которой необходимо поменять значение.
'    vVal         - значение для записи в ячейку rCell.
'                   Произвольный текст или ссылка на ячейку.
'    bRepFormat   - ИСТИНА(TRUE) - будет скопирован формат из rFormatRng.
'    rFormatRng   - ссылка на ячейку, формат которой необходимо копировать.
'---------------------------------------------------------------------------------------
'
Function ChangeAnotherCell(rCell As Range, vVal, Optional bRepFormat As Boolean = False, Optional rFormatRng As Range = Nothing) As String
    Application.Volatile
 
    If bRepFormat Then
        If Not rFormatRng Is Nothing Then
            With Application.ReplaceFormat
                .Clear
                .Font.Bold = rFormatRng.Font.Bold
                .Font.ColorIndex = rFormatRng.Font.ColorIndex
                .Font.FontStyle = rFormatRng.Font.FontStyle
                .Borders.Color = rFormatRng.Borders.Color
                .Borders.Weight = rFormatRng.Borders.Weight
                If Val(Application.Version) >= 12 Then 'версии старше 2003 не поддерживают копирование заливки
                    .Font.Name = rFormatRng.Font.Name
                Else
                    .Interior.ColorIndex = rFormatRng.Interior.ColorIndex
                End If
            End With
        End If
    End If
    With rCell
        If .Value = Empty Then
            .Replace Empty, vVal, 1, , 0, , , bRepFormat
        Else
            .Replace .Value, vVal, 1, , 0, , , bRepFormat
        End If
    End With
    Application.ReplaceFormat.Clear
End Function