Как автоматически перенести ячейку в другую без формулы?

[krestsoft]

Пример:
A1 - текст
B1 - текст
С1 - сцепка текста формулой
D1 - Вставка значения автоматически и чтобы его можно было править сразу как попало.

Поянть не могу, возможно ли такое?
Пардон за тупость, если что

[AlexM12]

Код в модуле листа

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Range("A2:B99"), Target) Is Nothing Then Exit Sub
    Cells(Target.Row, 4) = IIf(Cells(Target.Row, 1) <> Empty, Cells(Target.Row, 1) & " ", "") & Cells(Target.Row, 2)
    Cells(Target.Row, 4) = Cells(Target.Row, 1) & IIf(Cells(Target.Row, 2) <> Empty, " " & Cells(Target.Row, 2), "")
End Sub

[IgorGO]

krestsoft,
Вашу схему можно упростить на четверть, если удалить их нее элемент С1

[AlexM12]

Можно короче

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Range("A2:B99"), Target) Is Nothing Then Exit Sub
    Cells(Target.Row, 4) = Trim(Join(Split(Cells(Target.Row, 1) & " " & Cells(Target.Row, 2))))
End Sub

[krestsoft]

СПАСИБО РЕБЯТ! ВСЁ КРУТО!

[AlexM12]

Еще проще

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Range("A2:B99"), Target) Is Nothing Then Exit Sub
    Cells(Target.Row, 4) = Trim(Cells(Target.Row, 1) & " " & Cells(Target.Row, 2))
End Sub

[krestsoft]

Сообщение от AlexM12

Еще проще

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Range("A2:B99"), Target) Is Nothing Then Exit Sub
    Cells(Target.Row, 4) = Trim(Cells(Target.Row, 1) & " " & Cells(Target.Row, 2))
End Sub

Алексей, у меня почему-то не получается воспроизвести это в другом документе.
Вставляю код в другой документ через Alt+F11 в Лист1 (Лист1) и код не работает, так, как в примере. Вообще не работает.

Но мне нужны другие столбцы, не A2:B99, а допустим, B2:C9999.

Можете подсказать, что я не так делаю?
П.С. а в самом коде не вижу, как вставляются строки в ячейки D )

[AlexM12]

Если изменение значения произойдет в диапазоне A2:B99 (задано во второй строке кода), то будет выполнена третья строка кода.
Cells(Target.Row, 4) - 4 это номер столбца в которой записывается сцепка ячеек.
Cells(Target.Row, 1) - 1 это номер столбца в котором первое значение
Cells(Target.Row, 2) - 2 это номер столбца в котором второе значение
Под диапазон B2:C9999 код будет такой

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Range("B2:C9999"), Target) Is Nothing Then Exit Sub
    Cells(Target.Row, 4) = Trim(Cells(Target.Row, 2) & " " & Cells(Target.Row, 3))
End Sub

Сцепка осталась в столбце D

[krestsoft]

Сообщение от AlexM12

Если изменение значения произойдет в диапазоне A2:B99 (задано во второй строке кода), то будет выполнена третья строка кода.
Cells(Target.Row, 4) - 4 это номер столбца в которой записывается сцепка ячеек.
Cells(Target.Row, 1) - 1 это номер столбца в котором первое значение
Cells(Target.Row, 2) - 2 это номер столбца в котором второе значение
Под диапазон B2:C9999 код будет такой

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Range("B2:C9999"), Target) Is Nothing Then Exit Sub
    Cells(Target.Row, 4) = Trim(Cells(Target.Row, 2) & " " & Cells(Target.Row, 3))
End Sub

Сцепка осталась в столбце D

Спасибо. Поучительно.

Получается, чтобы сделать перенести текст из A в С и из B в D необходимо сделать примерно следующее?

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Range("A2:A9999"), Target) Is Nothing Then Exit Sub
    Cells(Target.Row,3) = Cells(Target.Row, 1)
    If Intersect(Range("B2:B9999"), Target) Is Nothing Then Exit Sub
    Cells(Target.Row, 4) = Cells(Target.Row, 2)
End Sub

А если в полях в столбцах A и B будут формулы, макрос сработает?

[AlexM12]

If Intersect(Range("A2:A9999"), Target) Is Nothing Then Exit Sub
В этой строке делается проверка. Если изменение значения произошло не в диапазоне A2:A9999, то макрос завершает работу.
Если вы измените значение в диапазоне B2:B9999, то макрос не сработает
Поэтому нужно так

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Range("A2:B9999"), Target) Is Nothing Then Exit Sub
    Cells(Target.Row, 3) = Cells(Target.Row, 1)
    Cells(Target.Row, 4) = Cells(Target.Row, 2)
End Sub