[a_axe]

ruslaw, попробуйте код ниже.
В тексте коде нужно поменять две вещи:
Заменить "Лист1" на реальное название вашего листа, и заменить " | " на реальный разделитель (т.е. если в одну ячейку скопировано несколько значений, они будут разделены знаком | и пробелами, если это не требуется, замените на пустую строку "".
Код нужно скопировать в модуль каждого листа, с которым работаете (в редакторе щелкнуть на иконке листа, с которым работаете). На других листах второй столбец также игнорируется, если это не нужно, удалите в экземпляре кода с этого листа Or Target.Column = 2

Код:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const strName  As String = "Лист1" 'Имя листа, на который будет выполняться копирование
Const strDelim  As String = " | " 'разделитель названий внутри ячейки, можно убрать содержимое между кавычками
If IsEmpty(Target.Cells(1, 1)) Or Target.Column = 2 Then Exit Sub
If IsEmpty(ThisWorkbook.Worksheets.Item(strName).Cells(Target.Row, 2)) Then
    ThisWorkbook.Worksheets.Item(strName).Cells(Target.Row, 2).Value = Target.Cells(1, 1).Value
Else
 ThisWorkbook.Worksheets.Item(strName).Cells(Target.Row, 2).Value = ThisWorkbook.Worksheets.Item(strName).Cells(Target.Row, 2).Value & strDelim & Target.Cells(1, 1).Value
End If


End Sub

[ruslaw]

Спасибо.
Но у меня такая проблема:
В первой колонке в ячейках стоят имена файлов. И мне надо во вторую колонку поместить полные имена папок, расположенные в других ячейках, чтобы потом приготовить из этих двух колонок код для перемещения файлов в нужные мне папки.
Ваш код помещает эти имена папок в ячейку второй колонки с тем же номером, что и у исходной (выделенной) ячейки, просто дублирует содержимое по горизонтали.
А мне нужно чтобы какую бы ячейку я ни выделил (кроме 1 и 2 столбцов) она дублировалась бы в верхнюю свободную ячейку второго столбца. Так я получу соответствие имен файлов в первом столбце и папок во втором, куда я хочу переместить файлы, указанные в ячейках первого.

[a_axe]

ruslaw, попробуйте так:

Код:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const strName  As String = "Лист1" 'Имя листа, на который будет выполняться копирование

If IsEmpty(Target.Cells(1, 1)) Or Target.Column < 3 Then Exit Sub
Target.Cells(1, 1).Interior.ColorIndex = 6 'выделяет ячейки желтым цветом, если не нужно - удалить строку
If IsEmpty(ThisWorkbook.Worksheets.Item(strName).Cells(60000, 2).End(xlUp)) Then
    ThisWorkbook.Worksheets.Item(strName).Cells(60000, 2).End(xlUp).Value = Target.Cells(1, 1).Value
Else
 ThisWorkbook.Worksheets.Item(strName).Cells(60000, 2).End(xlUp).Offset(1, 0).Value = Target.Cells(1, 1).Value
End If


End Sub

[ruslaw]

Огромнейшее спасибо! Все отлично работает!

[ruslaw]

Еще просьба.
Можно ли сделать такой макрос который к каждой ячейке добавлял бы комментарий с тем же содержанием что и в этой ячейке.
Так я смог бы видеть содержание ячеек с длинным содержимым, не нажимая на них.