О том, как при помощи несложного макроса VBA в программе «Эксель» можно разместить данные из таблицы в две колонки для распечатки на принтере.

Приведенный в статье макрос  является альтернативой опции «колонки» используемой в настройках «разметки страницы» программы Word .

Рассмотрим для примера таблицу с перечнем товаров хранящихся на складах. В данной таблице существует 4 столбца: номер подпункта, наименование товара, артикулярный номер товара на складе и место хранения (наименование склада).

Несмотря на то, что таблица имеет всего 4 столбца перечень товаров довольно обширный и  при отправке на печать занимает не один печатный лист. При проведении ревизии на складе носить с собой кипу бумаги неудобно.

Чтобы сэкономить немного бумаги, тонера и электроэнергии затраченной на печать сама собой возникает идея распечатать таблицу в две колонки на каждом листе, но реализовать данную идею не так уж просто.

Если в программе Word есть функция во вкладке «Разметка страницы» называемая «Колонки», которая позволяет делить текст на несколько колонок, то в Excel такой опции найти не удается.

Поэтому, чтобы разделить данные из таблицы на две колонки, необходимо записать макрос, который будет выполнять указанные действия.

Макрос выглядит следующим образом:

Sub DveKolonki()

    Dim sheetActive As Worksheet, sheetNoviy As Worksheet ‘добавляем переменные,  как листы

    Dim Vsego As Long, Perviy As Long  ‘добавляем переменные для определения границ таблицы

    Set sheetActive = ActiveSheet ‘присваиваем переменной активный лист

    Vsego = sheetActive.Cells.Find(What:=»?», LookIn:=xlValues, LookAt:= _

        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _

        , SearchFormat:=False).Row — 1 ‘определяем диапазон

    Perviy = Application.WorksheetFunction.RoundUp(Vsego / 2, 0) ‘делим диапазон

    Set sheetNoviy = Sheets.Add(, Sheets(Sheets.Count)) ‘определяем новый лист

    sheetNoviy.Range(«A1:E1»).Value = sheetActive.Range(«A1:E1»).Value

    sheetNoviy.Range(«F1:J1»).Value = sheetActive.Range(«A1:E1»).Value

    sheetNoviy.Range(«A2»).Resize(Perviy, 5).Value = sheetActive.Range(«A2»).Resize(Perviy, 5).Value

    sheetNoviy.Range(«F2»).Resize(Vsego — Perviy, 5).Value = _

        sheetActive.Range(«A» & Perviy + 2).Resize(Vsego — Perviy, 5).Value ‘делим таблицу

End Sub

Необходимо в панели разработчика открыть просмотр кода и добавить код макроса в книгу Excel.

Запускать макрос можно из перечня макросов (книги макросов) или присвоить его активному элементу, например, кнопке или чекбоксу.

Подробнее о присвоение макроса кнопке далее по ссылке.