Страницы: 1
RSS
В столбцы, вставленные между столбцами с данными, вписать данные из первых ячеек столбцов с данными
 
Здраствуйте уважаемые форумчане!
Нужно сделать макросом чтобы получить результат как показано на 2-м рисунке.
БУДУ ОЧЕНЬ БЛАГОДАРЕН ЗА ПОМОЩЬ.

Исходная таблица.




Нужный результат:


Mershik помог этим макросом. Результат хороший но незаполненны ячейки с номерами по всей таблице.
Код
Sub dsd()
Dim i As Long, lcol As Long
lcol = Cells(1, Columns.Count).End(xlToLeft).Columns
For i = lcol To 1 Step -1
Columns(i).EntireColumn.Insert
Cells(2, i) = Cells(1, i + 1)
Next i
End Sub
 
Цитата
Mershik написал:
я бы еще посоветовал наконец-то показать файл пример и сданными а не просто нумерованными столбцами
Загрузил реальный файл примера(урезанный, т.к. есть лимит по размеру файла). Буду ОЧЕНЬ БЛАГОДАРЕН за помощь, это секономит мне кучу времени.

Нужно продублировать названия столбцов в вставленных новых столбцах как показано на рисунках.
Изменено: yuraok - 09.07.2020 17:23:24
 
yuraok, не нашел связи с картинкой и файлом примером
Изменено: Mershik - 09.07.2020 19:32:59
Не бойтесь совершенства. Вам его не достичь.
 
Может непонятно потому что столбцы с ДАННЫМИ не полностью заполнены, но так должно быть.(такая структура нужна для импорта в интернет-магазин)

Суть - перед каждым столбцом вставить новый столбец и новый столбец до самого низу должен быть заполнен названием(заголовком - 1-я строка вверху) следующего столбца.
Все должно быть именно так как показано на втором рисунке, только вместо цифер должно идти текстовое название следующего столбца, а столбик с данными так и останется заполненн не полностью.
 
yuraok,
Код
Sub dsd()
Dim i As Long, lcol As Long, lr As Long

Application.ScreenUpdating = False
lcol = Cells.SpecialCells(xlLastCell).Column
lr = Cells.SpecialCells(xlLastCell).Row

    For i = lcol To 1 Step -1
        Columns(i).EntireColumn.Insert
        Range(Cells(2, i), Cells(lr, i)).Value = Cells(1, i + 1)
    Next i
    
Application.ScreenUpdating = True
End Sub

Изменено: Mershik - 09.07.2020 21:14:40
Не бойтесь совершенства. Вам его не достичь.
 
Спасибо БОЛЬШОЕ! Супер. Все именно так как нужно.
Вы заставляете верить в человечество )
Страницы: 1
Наверх