Как разнести данные по листам в excel

Разделение таблицы по листам

В Microsoft Excel есть много инструментов для сборки данных из нескольких таблиц (с разных листов или из разных файлов): прямые ссылки, функция ДВССЫЛ (INDIRECT), надстройки Power Query и Power Pivot и т.д. С этой стороны баррикад всё выглядит неплохо.

Но если вы нарвётесь на обратную задачу — разнесения данных из одной таблицы на разные листы — то всё будет гораздо печальнее. На сегодняшний момент цивилизованных встроенных инструментов для такого разделения данных в арсенале Excel, к сожалению, нет. Так что придется задействовать макрос на Visual Basic, либо воспольоваться связкой макрорекордер+Power Query с небольшой «доработкой напильником» после.

Давайте подробно рассмотрим, как это можно реализовать.

Постановка задачи

Имеем в качестве исходных данных вот такую таблицу размером больше 5000 строк по продажам:

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

Подготовка

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

Во-первых, создадим отдельную таблицу-справочник, где в единственном столбце будут перечислены все города, для которых нужно создать отдельные листы. Само-собой, в этом справочнике могут быть не все города, присутствующие в исходных данных, а только те, по которым нам нужны отчеты. Проще всего создать такую таблицу, используя команду Данные — Удалить дубликаты (Data — Remove duplicates) для копии столбца Город или функцию УНИК (UNIQUE) — если у вас последняя версия Excel 365.

Поскольку новые листы в Excel по умолчанию создаются перед (левее) текущего (предыдущего), то имеет смысл также отсортировать города в этом справочнике по убыванию (от Я до А) — тогда после создания листы-города расположатся по алфавиту.

Во-вторых, преобразуем обе таблицы в динамические («умные»), чтобы с ними было проще работать. Используем команду Главная — Форматировать как таблицу (Home — Format as Table) или сочетание клавиш Ctrl+T. На появившейся вкладке Конструктор (Design) назовём их таблПродажи и таблГорода, соответственно:

Способ 1. Макрос для деления по листам

На вкладке Разработчик (Developer) нажмите на кнопку Visual Basic или используйте сочетание клавиш Alt+F11. В открывшемся окне редактора макросов вставьте новый пустой модуль через меню Insert — Module и скопируйте туда следующий код:

Sub Splitter()
    For Each cell In Range("таблГорода")
        Range("таблПродажи").AutoFilter Field:=3, Criteria1:=cell.Value
        Range("таблПродажи[#All]").SpecialCells(xlCellTypeVisible).Copy
        Sheets.Add
        ActiveSheet.Paste
        ActiveSheet.Name = cell.Value
        ActiveSheet.UsedRange.Columns.AutoFit
    Next cell
    Worksheets("Данные").ShowAllData
End Sub	

Здесь с помощью цикла For Each … Next реализован проход по ячейкам справочника таблГорода, где для каждого города происходит его фильтрация (метод AutoFilter) в исходной таблице продаж и затем копирование результатов на новый созданный лист. Попутно созданный лист переименовывается в то же имя города и на нем включается автоподбор ширины столбцов для красоты.

Запустить созданный макрос в Excel можно на вкладке Разработчик кнопкой Макросы (Developer — Macros) или сочетанием клавиш Alt+F8.

Способ 2. Создаем множественные запросы в Power Query

У предыдущего способа, при всей его компактности и простоте, есть существенный недостаток — созданные макросом листы не обновляются при изменениях в исходной таблице продаж. Если обновление «на лету» необходимо, то придется использовать связку VBA+Power Query, а точнее — создавать с помощью макроса не просто листы со статическими данными, а обновляемые запросы Power Query.

Макрос в этом случае частично похож на предыдущий (в нём тоже есть цикл For Each … Next для перебора городов в справочнике), но внутри цикла будет уже не фильтрация и копирование, а создание запроса Power Query и выгрузка его результатов на новый лист:

Sub Splitter2()

For Each cell In Range("таблГорода")
    ActiveWorkbook.Queries.Add Name:=cell.Value, Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Источник = Excel.CurrentWorkbook(){[Name=""таблПродажи""]}[Content]," & Chr(13) & "" & Chr(10) & "    #""Измененный тип"" = Table.TransformColumnTypes(Источник,{{""Категория"", type text}, {""Наименование"", type text}, {""Город"", type text}, {""Менеджер"", type text}, {""Дата сделки"", type datetime}, {""Стоимость"", type number}})," & Chr(13) & "" & Chr(10) & "    #""Строки с примененным фильтром"" = Table.Se" & _
        "lectRows(#""Измененный тип"", each ([Город] = """ & cell.Value & """))" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Строки с примененным фильтром"""
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & cell.Value & ";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & cell.Value & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = cell.Value
        .Refresh BackgroundQuery:=False
    End With
    ActiveSheet.Name = cell.Value
Next cell
End Sub

После его запуска мы увидим те же листы по городам, но формировать их будут уже созданные запросы Power Query:

При любых изменениях в исходных данных достаточно будет обновить соответствующую таблицу правой кнопкой мыши — команда Обновить (Refresh) или обновить сразу все города оптом, используя кнопку Обновить всё на вкладке Данные (Data — Refresh All).

Ссылки по теме

• Что такое макросы, как их создавать и использовать
• Сохранение листов книги как отдельных файлов
• Сборка данных со всех листов книги в одну таблицу

Расскажи друзьям, если статья оказалась полезной:

    Видеоинструкции по использованию надстройки MulTEx

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

Разделить данные на несколько листов на основе столбца с кодом VBA

Разделить данные на несколько рабочих листов на основе столбца с Kutools for Excel

Разделить данные на несколько листов на основе столбца с кодом VBA

Если вы хотите быстро и автоматически разделить данные на основе значения столбца, следующий код VBA — хороший выбор. Пожалуйста, сделайте так:

1. Удерживайте ALT + F11 , чтобы открыть Microsoft Visual Basic для приложений окно.

2. Нажмите Вставить > Модулии вставьте следующий код в окно модуля.

Sub Splitdatabycol()
'updateby Extendoffice
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
Dim xTRg As Range
Dim xVRg As Range
Dim xWSTRg As Worksheet
Dim xWS As Worksheet
On Error Resume Next
Set xTRg = Application.InputBox("Please select the header rows:", "Kutools for Excel", "", Type:=8)
If TypeName(xTRg) = "Nothing" Then Exit Sub
Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Kutools for Excel", "", Type:=8)
If TypeName(xVRg) = "Nothing" Then Exit Sub
vcol = xVRg.Column
Set ws = xTRg.Worksheet
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = xTRg.AddressLocal
titlerow = xTRg.Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
Application.DisplayAlerts = False
If Not Evaluate("=ISREF('xTRgWs_Sheet!A1')") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
Else
Sheets("xTRgWs_Sheet").Delete
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
End If
Set xWSTRg = Sheets("xTRgWs_Sheet")
xTRg.Copy
xWSTRg.Paste Destination:=xWSTRg.Range("A1")
ws.Activate
For i = (titlerow + xTRg.Rows.Count) To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Set xWS = Sheets.Add(after:=Worksheets(Worksheets.Count))
xWS.Name = myarr(i) & ""
Else
xWS.Move after:=Worksheets(Worksheets.Count)
End If
xWSTRg.Range(title).Copy
xWS.Paste Destination:=xWS.Range("A1")
ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy xWS.Range("A" & (titlerow + xTRg.Rows.Count))
Sheets(myarr(i) & "").Columns.AutoFit
Next
xWSTRg.Delete
ws.AutoFilterMode = False
ws.Activate
Application.DisplayAlerts = True
End Sub

3, Затем нажмите F5 нажмите клавишу для запуска кода, и появится окно подсказки, напоминающее вам о выборе строки заголовка, см. снимок экрана:

4. А затем нажмите OK и во втором поле запроса выберите данные столбца, которые вы хотите разделить на основе, см. снимок экрана:

5, Затем нажмите OK, и все данные на активном листе разбиваются на несколько листов по значению столбца. И разделенные листы названы с именами разделенных ячеек. Смотрите скриншот:

Внимание: Разделенные листы помещаются в конец книги, где находится главный рабочий лист.

Разделить данные на несколько рабочих листов на основе столбца с Kutools for Excel

Примечание:Чтобы применить это Разделить данные, во-первых, вы должны скачать Kutools for Excel, а затем быстро и легко примените эту функцию.

После установки Kutools for Excel, пожалуйста, сделайте так:

1. Выберите диапазон данных, которые вы хотите разделить.

2. Нажмите Кутулс Плюс > Рабочий лист > Разделить данные, см. снимок экрана:

3. В Разделить данные на несколько листов диалоговое окно, вам необходимо:

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

2). Затем вы можете указать имена разделенных листов под Имя нового листа раздел, укажите правила имен рабочих листов из Правила раскрывающийся список, вы можете добавить Префикс or Суффикс также для имен листов.

3). Щелкните значок OK кнопка. Смотрите скриншот:

4. Теперь данные разделены на несколько листов в новой книге.

Нажмите, чтобы скачать Kutools for Excel и бесплатная пробная версия прямо сейчас!

Разделить данные на несколько рабочих листов на основе столбца с Kutools for Excel

Kutools for Excel включает более 300 удобных инструментов Excel. Бесплатная пробная версия без ограничений в течение 30 дней. Загрузите бесплатную пробную версию прямо сейчас!

Связанная статья:

Как разбить данные на несколько листов по количеству строк?