Как разделить файл Excel на отдельные файлы (по листам)
Такое бывает довольно часто, делаешь ежегодный отчет, а в нем 12 месяцев, соответственно 12 листов. И нужно разделить этот файл таким образом, чтобы каждый лист стал отдельным файлом.
И конечно же, можно сделать это руками, но это крайне долго и неэффективно.
Я продемонстрирую вам простой код Visual Basic, который выполнит задачу за вас.
Делим файл Excel на несколько файлов по листам
Допустим, у нас есть ежегодный отчет, в котором по листам расписаны показатели компании за каждый месяц. Как на картинке ниже:
Код Visual Basic, который разделит таблицу на несколько файлов по месяцам:
Sub SplitEachWorksheet() Dim FPath As String FPath = Application.ActiveWorkbook.Path Application.ScreenUpdating = False Application.DisplayAlerts = False For Each ws In ThisWorkbook.Sheets ws.Copy Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx" Application.ActiveWorkbook.Close False Next Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
Перед тем, как запустите этот код, сделайте следущее:
Узнайте Excel как свои пять пальцев на курсе по таблицам от Skillbox
- Создайте новую папку, куда поместите результаты работы этого кода;
- А также, на всякий случай, сделайте копию оригинального файла.
Теперь создайте функцию в Visual Basic и смело запускайте код.
Этот код сам найдет путь до папки с файлом.
Как он работает?
Довольно просто, он открывает каждый лист и сохраняет его как отдельный файл с тем же названием.
Куда поместить этот код?
- Щелкните на «Разработчик»;

- Далее откройте VBA;

- Правой кнопкой мышки на любой лист;.

- Щелкните на «Insert» -> «Module»;

- Поместите наш код в открывшееся окошко;

- Теперь запустите код.

Итак, как только вы запустите код, он сразу же разделит ваш файл на несколько файлов по листам. Это крайне удобно, советую его сохранить. Даже если сейчас он вам не нужен, в будущем обязательно пригодится.
Как я говорил ранее, имя файла такое же, как и имя листа.

Также не забудьте сохранить файл с соответствующим расширением(.XLSM), так как мы используем функции Visual Basic.
В коде я специально сделал так, чтобы вы не видели все что происходит и это вам не мешало. Вы можете исправить это если вам наоборот нужно видеть то, что происходит.
Но также, опять повторюсь, обязательно сделайте копию вашего файла перед использованием функции! Потому что если работа Excel завершится из-за какой-либо ошибки или произойдет еще что-то неожиданное вы можете потерять свои данные!
Делим файл Excel на несколько PDF файлов по листам
Вот код для такого случая:
Sub SplitEachWorksheet() Dim FPath As String FPath = Application.ActiveWorkbook.Path Application.ScreenUpdating = False Application.DisplayAlerts = False For Each ws In ThisWorkbook.Sheets ws.Copy Application.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FPath & "\" & ws.Name & ".xlsx" Application.ActiveWorkbook.Close False Next Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
И снова, не забудьте сначала создать папку и обязательно сделать копию оригинального файла. Код разделит вашу табличку по страницам и создаст для каждой страницы отдельный PDF файл.
Разделите только те рабочие листы, в которых содержится слово/фраза, на отдельные файлы Excel
Бывают и такие ситуации, что отдельный файл нужно создать только для тех страниц, в названии которых есть определенный текст.
Допустим, у вас есть страницы отчета за разные года, в названии каждого листа указан год и месяц. Но вам нужно сохранить только те листы, которые относятся к 2020 году. Как это сделать?
Рекомендуем курс Excel по анализу данных от Skypro — очень глубокое и яркое погружение в Эксель.
Вот код Visual Basic:
Sub SplitEachWorksheet() Dim FPath As String Dim TexttoFind As String TexttoFind = "2020" FPath = Application.ActiveWorkbook.Path Application.ScreenUpdating = False Application.DisplayAlerts = False For Each ws In ThisWorkbook.Sheets If InStr(1, ws.Name, TexttoFind, vbBinaryCompare) <> 0 Then ws.Copy Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx" Application.ActiveWorkbook.Close False End If Next Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
Как вы могли заметить, прямо в коде, мы создали переменную и задали ей значение 2020.
Затем этот код просто проходится по каждой странице и проверяет есть ли в имени нужная нам часть (то есть нужный год). А далее сохраняет отдельно только те листы, в имени которых он нашел совпадения.
Если совпадения не будут найдены — результат будет 0.
В этом коде используется цикл «Если/То». Если он находит нужное текстовое значение в имени листа, то сохраняет его отдельно, если не находит — просто пропускает.
Узнайте Excel как свои пять пальцев на курсе по таблицам от Skillbox
Как разделить .xlsx по строкам?
Есть большой файл больше 27 000 строк. Как его разделить на такие же .xlsx файлы, но скажем по 1000 строк?
- Вопрос задан более трёх лет назад
- 24572 просмотра
Комментировать
Решения вопроса 0
Ответы на вопрос 3

Принципы быстродействия VBA в описании
Если файл сохранён на диске, можно так:
1. Открываете книгу с данными на нужном листе
2. Заходите в VBA (Alt+F11)
3. Выбираете в меню Insert -> Module
4. Вставляете нижеприведённый код
5. Нажимаете F5 (не сохраняете исходный файл)
Option Explicit ' Обязательное объявление переменных Option Base 1 ' Нижняя граница массива (по умолчанию) '123456789012345678901234567890123456h8nor@ya567890123456789012345678toster56789 Sub Border_Limit() Dim Limit As Integer, Count As Integer, SaveDir As String, SetTitle As Boolean Count = 1: Limit = 1000 ' Счётчик файлов; Количество строк SetTitle = False ' Если есть заголовок, заменить False на True SaveDir = ThisWorkbook.Path ' Или вписать полный путь для сохранения "C:\" ' Предполагается, что в колонке A нет пустых ячеек While Not IsEmpty(Cells(IIf(SetTitle, 2, 1), 1)) Rows("1:" & Limit).Copy Workbooks.Add xlWBATWorksheet ' Создать новую книгу: шаблон с 1 листом ActiveSheet.Paste: Cells(1, 1).Select ActiveWorkbook.SaveAs Filename:=SaveDir & "\Массив_" & Count & ".xlsx", _ FileFormat:=xlOpenXMLWorkbook ActiveWindow.Close Rows(IIf(SetTitle, 2, 1) & ":" & Limit).Delete Shift:=xlUp Count = Count + 1 Wend: MsgBox "Файл разбит на " & Count - 1 & " файл(ов). " End Sub
Никакие C++ запускать не надо.
Для пытливых умов: Отказ от Слияния в пользу шаблонов https://toster.ru/q/320942
Ответ написан более трёх лет назад
Нравится 7 5 комментариев
Как сохранить ширину строк исходной таблицы? Также как сохранить заголовок во всех файлах? При выборе «2» заголовок не сохраняется.
Заранее спасибо

kolyayolo, благодарю за замечание (обновил код), и хороший вопрос.
Для переноса ширины колонок нужно после объявления переменных сохранить значения ширины колонок в массив:
ReDim colWidth(Cells.SpecialCells(xlLastCell).Column) For Count = 1 To UBound(colWidth) ' Читаем ширину колонок colWidth(Count) = Cells(1, Count).ColumnWidth Next Count
Затем, после вставки данных перенести значения ширины колонок из массива:
' Пишем ширину колонок Cells(1, 1).Resize(1, UBound(colWidth)).ColumnWidth = colWidth
alcompstudio @alcompstudio
Спасибо за решение, искал везде, ваш подошел идеально! Единственный вопрос — а как сделать, чтобы полученные таблицы-файлы были «упакованы» в умные таблицы на выходе? Я не силен в VBA, подскажете какой код и куда его вписать?
alcompstudio @alcompstudio
Добавил код, который добавляет умную таблицу к диапазону, но есть проблема. У меня файлы формируются из заранее подготовленной умной таблицы, т.е. она разбивается на части. И этот (ваш) код получается формирует файлы с не отформатированными диапазонами, а последний файл именно форматируется в умную таблицу (как бы унаследует формат из исходного файла). Т.е. не все сформированные файлы с умными таблицами получаются, а только последний. А мне нужно, чтобы все были оформлены в умные таблицы. Я добавил код, который добавляет формат в полученные файлы, вот такое у меня получилось:
Option Explicit ' Обязательное объявление переменных Option Base 1 ' Нижняя граница массива (по умолчанию) '12345678901234567890123456789012345bopoh13@ya67890123456789012345678toster56789 Sub Border_Limit() Dim Limit As Integer, Count As Integer, SaveDir As String, SetTitle As Boolean Count = 1: Limit = 2001 ' Счётчик файлов; Количество строк SetTitle = True ' Если есть заголовок, заменить False на True SaveDir = "F:\ZeusCeramica\Веб-система\Руководитель\Спецификации" ' Или вписать полный путь для сохранения "F:\ZeusCeramica\Веб-система\Руководитель\Спецификации" или ThisWorkbook.Path ' Предполагается, что в колонке A нет пустых ячеек While Not IsEmpty(Cells(IIf(SetTitle, 2, 1), 1)) Rows("1:" & Limit).Copy Workbooks.Add xlWBATWorksheet ' Создать новую книгу: шаблон с 1 листом ActiveSheet.Paste: Cells(1, 1).Select '-------Оформляем полученные таблицы в умные---------- Dim a As Long 'Определяем количество строк a = Cells(1, 1).CurrentRegion.Rows.Count 'Создаем «умную» таблицу с сохранением первой строки заголовков ActiveSheet.ListObjects.Add(xlSrcRange, Range(Cells(1, 1), Cells(a, 17)), , xlYes).Name _ = "TableRange" ActiveWorkbook.SaveAs Filename:=SaveDir & "\BOM_test_" & Count & ".xlsx", _ FileFormat:=xlOpenXMLWorkbook ActiveWindow.Close Rows(IIf(SetTitle, 2, 1) & ":" & Limit).Delete Shift:=xlUp Count = Count + 1 Wend: MsgBox "Файл разбит на " & Count - 1 & " файл(ов). " End Sub
Но в результате получается ошибка, т.к. система пытается последнюю таблицу, которая «умная» тоже повторно оформить.
Подскажете, как подправить?

kolyayolo, alcompstudio, на технических ресурсах принято выражать свою положительную оценку кнопкой «Нравится«, тем самым указывая на полезность материала.
Для создания умной таблицы для всего активного листа с именем «Table_1» используется следующий метод (четвёртый параметр указывает на наличие заголовков):
ActiveSheet.ListObjects.Add(, ActiveSheet.UsedRange, , xlYes).Name = "Table_1"
Для удаления единственной умной таблицы на активном листе используется метод:
ActiveSheet.ListObjects(1).Delete
Excel Разделитель
Нажмите Ctrl + D, чтобы сохранить его в закладках и не искать его снова.
Поделиться через фейсбук
Поделиться в Твиттере
Поделиться в LinkedIn
Посмотреть другие приложения
Попробуйте наш облачный API
Добавьте это приложение в закладки
Обработанные файлы
Загружено MB
Aspose.Cells Excel Splitter
Это бесплатное онлайн-приложение, позволяющее легко извлекать листы из файлов Excel. Возможно, вам придется разделить большую книгу на отдельные файлы Excel с сохранением каждого листа книги в виде отдельного PDF, DOCX, PPTX, XLS, XLSX, XLSM, XLSB, XLT, ET, ODS, CSV, TSV, HTML, JPG, Файлы BMP, PNG, SVG, TIFF, XPS, JSON, XML, SQL, MHTML и Markdown. Excel Splitter может эффективно разделить большую книгу на отдельные файлы Excel на основе каждого листа онлайн из Mac OS, Linux, Android, iOS и где угодно.
- Расколоть XLS, XLSX, XLSM, XLSB, ODS, NUMBERS
- Сохранить в желаемый формат: Xlsx, Xls, Xlsm, Xlsb, Ods
- Разделить таблицу Excel по листам
- Разделить на несколько файлов таблиц Excel
- Сохранять стили исходной таблицы Excel.
- Разделить файл электронной таблицы OpenDocument
Как разделить файлы Excel
- Загрузите файлы Excel для разделения.
- Нажмите кнопку «РАЗДЕЛИТЬ».
- Загрузите разделенные файлы мгновенно или отправьте ссылку для скачивания на электронную почту.
Обратите внимание, что файл будет удален с наших серверов через 24 часа, а ссылки для скачивания перестанут работать по истечении этого периода времени.
Быстрый и простой сплиттер
Загрузите таблицу Excel и нажмите кнопку «РАЗДЕЛИТЬ». Вы получите zip-файл с результирующими файлами таблиц Excel сразу после выполнения разделения.
Анализ из любого места
Он работает на всех платформах, включая Windows, Mac, Android и iOS. Все файлы обрабатываются на наших серверах. Вам не требуется установка плагинов или программного обеспечения.
Поддерживается Aspose.Cells . Все файлы обрабатываются с использованием API-интерфейсов Aspose, которые используются многими компаниями из списка Fortune 100 в 114 странах.
Как разделить эксель на два файла
Argument ‘Topic id’ is null or empty
Сейчас на форуме
© Николай Павлов, Planetaexcel, 2006-2023
info@planetaexcel.ru
Использование любых материалов сайта допускается строго с указанием прямой ссылки на источник, упоминанием названия сайта, имени автора и неизменности исходного текста и иллюстраций.
| ООО «Планета Эксел» ИНН 7735603520 ОГРН 1147746834949 |
ИП Павлов Николай Владимирович ИНН 633015842586 ОГРНИП 310633031600071 |
