Объединение столбцов

[verdi]

Добрый день!
Подскажите, пожалуйста, макрос для объединения столбцов.
Таблице в экселе, пример во вложении (в ворде)

Первые 4 столбца - то, что есть, последний - то, что должно получиться в результате.
т.е., нужно как-то объединить данные из столбцов через запятую с указанием названия столбцов в одной строке.
Отдельно для каждой строки.

Пробовал использовать формулы типа "Сцепление", но это не помогает, т.к. полученные данные нужно перенести в другую книгу, при этом, не засоряя ее дополнительными листами с данными + эти данные необходимо будет менять. Словом, нужен макрос, чтобы данные можно было редактировать прямо в тех ячейках, в которых мы их видим.
Нужно, чтобы результат не был привязан никак к исходным данным.

Сам от программирования также далек, поэтому, к сожалению, сам написать макрос не могу, а руководство задачу поставило.
Буду очень признателен за помощь!

[SAS888]

Можно так:

Sub Main()
    Dim i As Long, a(), b(): Application.ScreenUpdating = False
    a = Range([A2], Cells(Cells(Rows.Count, 1).End(xlUp).Row, 4)).Value: ReDim b(1 To UBound(a, 1), 1 To 1)
    For i = 1 To UBound(a, 1): b(i, 1) = "Тел.:" & a(i, 1) & ", Факс: " & a(i, 2) & ", E-mail:" & a(i, 3) & ", Сайт:" & a(i, 4): Next
    Range([E2], Cells(UBound(b, 1) + 1, 5)).Value = b
End Sub

Пример во вложении. Запустите макрос "Main".

[verdi]

Хорошая работа неизменно вызывает восхищение, до чего все просто использовать, четкий и понятный результат. Спасибо Вам огромное!

Возможно ли сделать так, чтобы макрос так поступал с выделенным мышкой диапазоном, объединяя данные в тех же ячейках, в которых они находятся, или его нужно переписывать под каждый конкретный диапазон?

Баз ОЧЕНЬ много, и все разные. Коллеги постарались на славу

[SAS888]

Требуется уточнение. Лучше всего на примере. Так, если в примере из вложения в посте № 2 выделить диапазон ячеек "B2:C3", то что в каких ячейках должно появиться? Что делать, если есть пустые ячейки в выделенном диапазоне? Что делать, если в выделенный диапазон попадают ячейки из строки с заголовками?

[verdi]

Да, конечно, вот описание на Вашем примере:

при выделении B2:C2 и задействовании макроса должно получиться bbb, ccc в ячейке B2.
при выделении B2:D2 и задействовании макроса должно получиться bbb, ccc, ddd, соответственно в ячейке B2.
при выделении B3:B4 и задействовании макроса должно получиться yy, ee в ячейке B3.
при выделении B2:C3 и задействовании макроса должно получиться bbb, ccc, yy, zz в ячейке B2 (но этот пункт уже не принципиален, т.к. вроде пока однозначной потребности в этом не было замечено).

т.е. нужно, чтобы именно информация из выделенного мышкой участка диапазона объединялась с сохранением данных через запятую, неважно, выделены строки или столбцы. Вся информация должна появиться в первой ячейке выделенного диапазона.
Если ячейки из строки с заголовками попадут, то пусть они тоже объединятся Если пустые, то пусть они будут гордо проигнорированы ))

по функционалу примерно как функция "объединить ячейки", но ячейки как раз объединять не обязательно, главное - информацию перенести в левый верхний. Важно еще, чтобы выделять нужно было именно мышкой, т.к. много мелких разнокалиберных участков, а макрос вручную перенастраивать для каждого кусочка из двух-трех ячеек в таблицах по 3000 строк придется Долго
Спасибо!

[SAS888]

Можно так:

Sub Main()
    Dim s As String, Cell: Application.ScreenUpdating = False
    For Each Cell In Selection
        If Cell <> "" Then s = s & IIf(Cell.Column = 4, "Сайт", Cells(1, Cell.Column)) & ":" & Cell & ", "
    Next
    If s <> "" Then s = Left(s, Len(s) - 2)
    Cells(Selection.Row, 5) = s
End Sub

Пример во вложении. Выделите требуемый диапазон и запустите макрос "Main".

[verdi]

Жаль, второй плюс Вам в репутацию поставить нельзя.
Спасибо огромное, без Вашей помощи еще не знаю, сколько бы сидел