Заполнение ячеек содержимым других ячеек (Excel)

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Microsoft Office (Word, Excel, Outlook и т.д.) (http://forum.oszone.net/forumdisplay.php?f=115)

Заполнение ячеек содержимым других ячеек (Excel)

Имеется такая задача
На листе xlsx-файла второй столбец пустой, а остальные заполнены содержимым (в каждой ячейке - своим). Мне необходимо чтобы при выделении любой ячейки (кроме принадлежащих ко второму столбцу) ее содержимое копировалось в свободную ячейку второго столбца в нисходящем порядке (кликов предполагается много).
Так же есть и другие листы с заполненными ячейками. Необходимо чтобы клики на их ячейки копировали их содержание во второй столбец первого листа на общих основаниях согласно единой последовательности кликов.
Задача вызвана потребностью организовать быстрый разбор файлов из папки загрузок в папки файлохранилища.
Если можно прошу помочь с макросом

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

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

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

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

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