Сохранение листов книги как отдельных файлов
Про сборку листов из нескольких книг в одну текущую я уже писал здесь. Теперь разберем решение обратной задачи: есть одна книга Excel, которую нужно "разобрать", т.е. сохранить каждый лист как отдельный файл для дальнейшего использования.
Примеров подобного из реальной жизни можно привести массу. Например, файл-отчет с листами-филиалами нужно разделить на отдельные книги по листам, чтобы передать затем данные в каждый филиал и т.д.
Если делать эту процедуру вручную, то придется для каждого листа выполнить немаленькую цепочку действий (выбрать лист, правой кнопкой по ярлычку листа, выбрать Копировать, указать отдельный предварительно созданный пустой файл и т.д.) Гораздо проще использовать короткий макрос, автоматизирующий эти действия.
Способ 1. Простое разделение
Нажмите сочетание Alt+F11 или выберите в меню Сервис - Макрос - Редактор Visual Basic (Tools - Macro - Visual Basic Editor), вставьте новый модуль через меню Insert - Module и скопируйте туда текст этого макроса:
Sub SplitSheets1() Dim s As Worksheet For Each s In ActiveWorkbook.Worksheets 'проходим по всем листам в активной книге s.Copy 'копируем каждый лист в новый файл Next End Sub
Если теперь выйти из редактора Visual Basic и вернуться в Excel, а затем запустить наш макрос (Alt+F8), то все листы из текущей книги будут разбиты по отдельным новым созданным книгам.
Способ 2. Разделение с сохранением
При необходимости, можно созданные книги сразу же сохранять под именами листов. Для этого макрос придется немного изменить, добавив команду сохранения в цикл:
Sub SplitSheets2() Dim s As Worksheet Dim wb as Workbook Set wb = ActiveWorkbook For Each s In wb.Worksheets 'проходим во всем листам активной книги s.Copy 'сохраняем лист как новый файл ActiveWorkbook.SaveAs wb.Path & "\" & s.Name & ".xlsx" 'сохраняем файл Next End Sub
Этот макрос сохраняет новые книги-листы в ту же папку, где лежал исходный файл. При необходимости сохранения в другое место, замените wb.Path на свой путь в кавычках, например "D:\Отчеты\2012" и т.п.
Если нужно сохранять файлы не в стандартном формате книги Excel (xlsx), а в других (xls, xlsm, xlsb, txt и т.д.), то кроме очевидного изменения расширения на нужное, потребуется добавить еще и уточнение формата файла - параметр FileFormat:
ActiveWorkbook.SaveAs wb.Path & "\" & s.Name & ".xlsb", FileFormat:=50
Для основных типов файлов значения параметра FileFormat следующие:
- XLSX = 51
- XLSM = 52
- XLSB = 50
- XLS = 56
- TXT = 42
Способ 3. Сохранение в новые книги только выделенных листов
Если вы хотите раскидать по файлам не все листы в вашей книге, а только некоторые, то макрос придется немного изменить. Выделите нужные вам листы в книге, удерживая на клавиатуре клавишу Ctrl или Shift и запустите приведенный ниже макрос:
Sub SplitSheets3() Dim AW As Window Set AW = ActiveWindow For Each s In AW.SelectedSheets Set TempWindow = AW.NewWindow 'создаем отдельное временное окно s.Copy 'копируем туда лист из выделенного диапазона TempWindow.Close 'закрываем временное окно Next End Sub
Создавать новое окно и копировать через него, а не напрямую, приходится потому, что Excel не умеет копировать группу листов, если среди них есть листы с умными таблицами. Копирование через новое окно позволяет такую проблему обойти.
Способ 4. Сохранение только выделенных листов в новый файл
Во всех описанных выше способах каждый лист сохранялся в свой отдельный файл. Если же вы хотите сохранить в отдельный новый файл сразу группу выделенных предварительно листов, то нам потребуется слегка видоизменить наш макрос:
Sub SplitSheets4() Dim CurW As Window Dim TempW As Window Set CurW = ActiveWindow Set TempW = ActiveWorkbook.NewWindow CurW.SelectedSheets.Copy TempW.Close End Sub
Способ 5. Сохранение листов как отдельных PDF-файлов
Этот способ чем-то похож на второй, но листы сохраняются не как отдельные книги Excel, а в формате PDF, что часто требуется, если никто не должен менять документ и увидеть ваши формулы. Обратите внимание, что:- для этого используется уже другой метод (ExportAsFixedFormat а не Copy)
- листы выводятся в PDF с параметрами печати, настроенными на вкладке Разметка страницы (Page Layout)
- книга должна быть сохранена на момент экспорта
Нужный нам код будет выглядеть следующим образом:
Sub SplitSheets5() Dim s As Worksheet For Each s In ActiveWorkbook.Worksheets s.ExportAsFixedFormat Filename:=ThisWorkbook.Path & "\" & s.Name & ".pdf", Type:=xlTypePDF Next End Sub
Способ 6. Готовый макрос из надстройки PLEX
Если лень или нет времени внедрять все вышеописанное, то можно воспользоваться готовым макросом из моей надстройки PLEX:
Ссылки по теме
- Сборка листов из нескольких книг в одну
- Что такое макросы, куда вставлять код на Visual Basic, как их использовать.
1. Имя листа;
2. содержимое ячейки A9 каждого листа (это текст, название организации).
Кто может подсказать?
Можно в отдельном файле, можно в том же на новый лист.
или направьте в какой теме спросить...
Спасибо.
В строке:
Что ей в имени не нравится?!
Большое спасибо за тему и множество комментариев.
Не нашёл здесь готового решения для такого случая:
Нужно сохранить 2 конкретных листа с определёнными названиями из книги со множеством листов в отдельную книгу и задать ей общее имя.
Также формулы на листах нужно заменить на значения с сохранением формата ячеек.
Plex помог не целиком. Да и хотелось бы сделать кнопку на одном из листов, которая бы выполняла эту процедуру.
Буду чертовски рад комментариям:)
Подскажите, пожалуйста, пробовал по 5 способу добавить макрос.
Теперь при каждом открытии любой книги Excel создаются два файла *.pdf и никак не получается это убрать, уже поудалял все макросы.
Заранее спасибо!
А есть какой-нибудь способ также разделить много книг за один раз?
Помогите пожалуйта
[img]blob:https://www.planetaexcel.ru/30ffaf5b-798f-455f-9148-9ee727968db3[/img]
[img]blob:https://www.planetaexcel.ru/9389e6b4-bc53-4fc7-8dc8-1f4974f5fc32[/img]
[img]blob:https://www.planetaexcel.ru/d5cb7486-5ba2-4584-a4c1-41aa9a34ca96[/img]
Sub SplitSheets3()
Dim AW As Window
Set AW = ActiveWindow
For Each s In AW.SelectedSheets
Set TempWindow = AW.NewWindow 'создаем отдельное временное окно
s.Copy 'копируем туда лист из выделенного диапазона
TempWindow.Close 'закрываем временное окно
Next
End Sub
Как мне переделать код, чтобы сохранялись конкретные листы отдельно, а конкретные - одним файлом.
Мне надо, чтобы 1, 2 и 3 лист сохранялись в текущую папку отдельными файлами эксель, а 4, 5, 6 и 7 - в эту же папку одним файлом.
Заранее большое спасибо за ответ, очень поможете....
А как добавить к
В моём примере если код замены формул вставить высоко, то формулы в обоих книгах заменяются, а если низко, то в результате вместо формул значения "#Н/Д"
Помогите пожалуйста, был написан макрос, но к сожалению теперь утерян :
Сохраниение активного листа в новую книгу, в папку где находится исходный файл, имя файла = название листа
Далее отправка нового файла через Outlook , адрес эл.почты из ячейки A1, тема письма прописана в макросе
Сейчас есть только начало:
Sub SohrList()
Dim CurrentWin As Window
Dim VremWin As Window
Set CurrentWin = ActiveWindow
Set VremWin = ActiveWorkbook.NewWindow
CurrentWin.ActiveSheet.Copy
VremWin.Close
sPath = ThisWorkbook.Path
ThisWorkbook.SaveAs (ThisWorkbook.Path)
End Sub
макрос создает файл с листом, но не берет название и не сохраняет
при попытках разбить Plex формулы во всех разбитых листах едут(
Compile error: Syntax error
Раньше все работало.
1. Обновление экрана не отключено, из-за этого процесс по длительности возрастает в разы, но это только начало сказки...
2. При большом объёме листов в книге, все листы, которые разделяются и сохраняются в файлы не закрываются, а накапливаются открытыми, из-за этого процесс EXCEL только наращивает в памяти и в итоге вообще зависает...
3. В шапке макроса отсутствует Msg бокс для запуска макроса, может запуститься и "повесит" всю работу компьютера.
4. После работы макроса не понятно, какой объём работы выполнил макрос?
После всего выше сказанного, прошу рассмотреть данный вариант:
Sub Splitbook()
Dim msg
msg = MsgBox("Хотите разделить листы книги на отдельные книги excel?", vbYesNo, "Разделение листов по отдельным книгам!"
If msg = 7 Then Exit Sub
Dim xPath As String, Count As Integer
On Error Resume Next
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ActiveWorkbook.Sheets
If xWs.Visible Then
xWs.Copy
Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
Application.ActiveWorkbook.Close False
Count = Count + 1
End If
Next xWs
MsgBox "Листы из файла, в количестве " & Count & " шт., разделены!"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Реализую способ №3, дополнил его кодом который меняем формулы на значения.
Однако сохранять файлы отказывается, выдает ошибку. Если убрать код сохранения - просто открывает новые листы "стопкой".
Помогите, пожалуйста, решить проблему.
Есть вот такой макрос (способ 5), который сохраняет листы в отдельные файлы
и присваивает наименование файла с ячейки H2. В ячейке H2 на каждом листе у меня
текст К ДОГОВОРУ № 008-0211-5 от 01.10.2023. (номера договоров и даты разные на листах разные).
Макрос выводит ошибку когда видет номер № 0000000009624Р000002/2269/2250-16-5244 от 01.01.2013
и дальше никуда.
Sub SplitSheets5()
Dim s As Worksheet
For Each s In ActiveWorkbook.Worksheets
s.ExportAsFixedFormat Filename:=ThisWorkbook.Path & "\" & s.Range("H2") & ".pdf", Type:=xlTypePDF
Next
End Sub
Воспользовался способом 5 для сохранения листов в отдельные файлы
с присвоением наименования файла с ячейки H2 каждого листа.
В ячейке H2 каждого листа есть текст К ДОГОВОРУ № 008-0211-5 от 01.10.2023
(номер договора на каждом листе свой и дата тоже). макрос уходит в ошибку
когда видит на листе номер 0000000009624Р000002/2269/2250-16-5244
Помогите пожалуйста решить эту проблему. Вообще листов около 7000.
И мне их надо все в PDF отдельными файлами и отправить на почту клиентам через outlook
сам макрос:
Sub SplitSheets5()
Dim s As Worksheet
For Each s In ActiveWorkbook.Worksheets
s.ExportAsFixedFormat Filename:=ThisWorkbook.Path & "\" & s.Range("H2") & ".pdf", Type:=xlTypePDF
Next
End Sub