Сохранение листов книги как отдельных файлов

Про сборку листов из нескольких книг в одну текущую я уже писал здесь. Теперь разберем решение обратной задачи: есть одна книга Excel, которую нужно "разобрать", т.е. сохранить каждый лист как отдельный файл для дальнейшего использования.

save-sheets-as-files.png

Примеров подобного из реальной жизни можно привести массу. Например, файл-отчет с листами-филиалами нужно разделить на отдельные книги по листам, чтобы передать затем данные в каждый филиал и т.д.

Если делать эту процедуру вручную, то придется для каждого листа выполнить немаленькую цепочку действий (выбрать лист, правой кнопкой по ярлычку листа, выбрать Копировать, указать отдельный предварительно созданный пустой файл и т.д.) Гораздо проще использовать короткий макрос, автоматизирующий эти действия.

Способ 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
Полный список всех вариантов можно посмотреть в справке MSDN.

Способ 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:


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

 


Страницы: 1  2  
Сергей
05.01.2013 16:35:32
А если мне нужно сохранять новые файлы не в ту же папку, где лежал исходный файл?
05.01.2013 16:36:17
Хороший вопрос. Дописал примечание ко второму макросу - посмотрите.
23.09.2018 00:04:59
А как сослаться на ячейку А1, в которой указан путь для сохранения файла
Путь для каждого листа разный
18.01.2013 09:01:47
Почемуто способ 3 не работает, сначала ругался на то что не определена переменная s, потом ругается на неверные типы данных.
20.01.2013 19:27:06
Допишите в код dim s as Worksheet после первой строки.
А еще лучше - скачайте пример в заголовке статьи и посмотрите как все работает вживую.
20.01.2013 21:05:19
Спасибо за проделываемую работу, подошол 4 способ, добавил в код сохранение только значений и готов к отправке хоть кому файл.
22.03.2013 16:04:05
Все здорово работает, но есть один вопрос. Каким образом можно видоизменить 3 способ чтобы в новые листы сохранялись только значения. Само собой, с сохранением форматирования.
15.02.2014 15:00:26
Добавить перед сохранением скопированного листа проход по всем ячейкам с заменой формул на значения. Что-то типа:
For Each cell in ActiveSheet.UsedRange.Cells
   cell.Formula = cell.Value
Next cell
07.04.2015 00:06:58
Скажите, а как это реализовать, если на каждом листе сводная таблица?
04.11.2013 20:09:02
Добрый день!
Вопрос собственно такой: как сохранить лист или диапазон ячеек в формате html?
пробовал таким способом - сохраняет в каком-то формате, который не понимает браузер.
ThisWorkbook.Sheets("SHEET3").Copy
ActiveWorkbook.SaveAs "C:\table.htm", fileformat:=44 
ActiveWorkbook.Close
Спасибо!
14.02.2014 17:35:08
Здравствуйте! Подскажите пожалуйста как сделать так чтобы в отдельный файл сохранялся лист с определённым названием, а не все листы книги, чтобы файл сохранялся под названием листа с расширением .csv , в той же папке что и исходная книга и после сохранения остался закрытым
15.02.2014 14:54:56
Советую запустить макрорекордер (вкладка Разработчик - Запись макроса), выполнить сохранение нужного листа в CSV и посмотреть на код. Будет как раз то, что вам нужно, только слегка необходимо будет модифицировать:
    p = ActiveWorkbook.Path
    Sheets("Лист2").Copy
    ActiveWorkbook.SaveAs Filename:= p & "\Лист2.csv", FileFormat:=xlCSV
    ActiveWindow.Close
18.02.2014 23:24:49
Спасибо Николай за совет, очень мне помогли, я как то сам не догадался посмотреть макрос записанный с помощью макрорекодера. У меня получилось сохранить файл так как я и хотел. Но возникла другая проблема. При сохранении CSV файла макросом в качестве разделителя ячеек Excel использует запятую вместо точки с запятой как должно быть в русской версии если сохранять файл вручную. Я почитал этот форум и посмотрел в интернете но решения не нашёл. Может вы или кто другой подскажите возможно ли решить эту проблему, то есть сохранить макросом файл в CSV формате с разделителем ячеек точка запятая. Если такого прямого решения нет то как вариант подскажите возможно ли создание макроса который сразу после сохранения файла в формате CSV открыл бы его в Блокноте и произвёл замену всех запятых на точки с запятыми и закрыл бы файл. такой вариант меня бы устроил так как в данном файле нужных мне запятых нет и все что поставит excel можно заменить.
08.05.2014 10:06:55
Он и должен использовать запятую, ибо CSV - это comma separated values, т.е. значения разделенные запятыми. Может склеивать текст в новый промежуточный файл с помощью функции СЦЕПИТЬ и точки с запятой, а потом уже сохранять его в CSV?
01.02.2018 13:28:53
Добрый день.
Вообще ничего не понимаю в макросах, что я делаю не так из предложенного?
Задача: необходимо Лист2 всегда сохранять в отдельный файл с именем из ячейки A5 именно из Листа2. Как это прописать?
Спасибо.
25.02.2014 12:44:55
Добрый день! А как можно сделать, чтобы способ 4 сохранял еще и скрытые листы помимо выделенных? Заранее спасибо!
04.07.2014 09:36:04
Добавить к нему еще и проход по листам с проверкой на видимость. Что-то типа:
    For Each s In ActiveWorkbook.Worksheets    'проходим по всем листам в активной книге
        if s.Visible = False Then s.Copy       'если лист скрыт, то копируем его в новый файл
    Next
03.07.2014 22:21:59
Добрый день.
Для полного счастья в 3 способе не хватает возможности "разорвать связи" в новых листах. Вроде задача простая, а сообразить не могу :(
04.07.2014 09:27:13
Ирина, чуть выше в комментах уже спрашивали такое - ответил.
04.07.2014 10:27:58
Почти...
Выше речь шла о замене формул на значения... мне как раз формулы необходимо оставить (в рамках листа), а связи с книгой разорвать.
04.07.2014 11:09:45
Понял. Тогда можно попробовать таким кодом:
Set wb = ActiveWorkbook
WorkbookLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
        If IsArray(WorkbookLinks) Then
            For i = LBound(WorkbookLinks) To UBound(WorkbookLinks)
                wb.BreakLink Name:=WorkbookLinks(i), Type:=xlLinkTypeExcelLinks
            Next i
        End If
07.07.2014 18:42:31
Добрый вечер!

Большое спасибо за очень полезную информацию!
Сработали все 3 способа (первый не пробовала), за исключением 2 моментов:

при способе №2 из 40 с лишним вкладок открылось только 25 шт в новых документах с сохранением названия вкладки, как и должно было быть. Остальные вкладки даже не показались, мб есть какое-то ограничение по кол-ву вкладок?

Второй момент:  Подскажите пожалуйста,как нужно дописать макрос, чтобы способ номер 3 сохранял вкладки в документы с названием вкладок, как в способе 2?

Спасибо!
Марина
21.08.2014 16:04:39
Николай, доброго дня.
Подскажите, как реализовать копирование диапазона листа в новую книгу. С листом понятно, но на нём много лишних данных, которые в новой книге не нужны.
С ув., Василий
21.08.2014 18:38:34
Будет что-то вроде:
Range("A1:B2").Copy
Workbooks.Add
ActiveSheet.Paste 
Потом сохранить получившуюся книгу в нужное место.
22.01.2015 12:46:15
Нужно было создать 370 файлов из вкладок, комп заругался что его ресурсов на это не хватает (при выполнении макроса открывается еще одно окно Excel с данными. И так по каждой вкладке). Чтобы всего хватало и не приходилось закрывать созданные файлы добавил строчку. Может кому пригодится. Взял макрос из примера 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"  'сохраняем файл
        ActiveWorkbook.Close False               'закрываем созданный файл
    Next
    End Sub 
04.03.2015 12:51:42
Спасибо, отличный сайт! Чудеса просто можно делать с вашей помощью!
05.03.2015 11:21:39
Подскажите, сохраняю каждый файл в TXT формате вот этим макросом:
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 & ".txt" 
    ActiveWorkbook.Close
    Next
End Sub
Создаются как и надо текстовые документы, но при их открытии, там набар символов. Как сделать чтобы сохранялось правильно?
И еще может подскажете, мне нужно чтобы после того как сохранился лист в TXT, он после этого менял своё расширение на HTML, вообщем сайт пишу в XL, каждый лист у меня это страничка, на листах я пишу HTML код в чистом виде, вот мне и нужно чтобы макрос сначало в TXT перегонял без форматирования и формул, потом сохранял как HTML страничку. Надеюсь я понятно описал то что хочу сделать, спасибо)
Дописал:
FileFormat:=xlText 
Сохраняет, но там где формула ставит - #VALUE!
16.04.2015 08:22:45
Здравствуйте, подскажите пожалуйста как реализовать 2 способ копирования, чтобы скопированный лист вставлялся значениями (в исходном листе много формул которые в отчете ненужно показывать)
22.09.2015 07:54:04
Здравствуйте, подскажите пожалуйста, как в способе 2 добавить к названию файла кроме имени листа текстовое значение конкретной ячейки на листе (в моем случае А22)?
10.11.2016 10:28:40
 
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 & s.Range("A22") & ".xlsx"  'сохраняем файл
    Next
End Sub
20.03.2016 14:02:37
здравствуйте!  спасибо большое за макрос
подскажите пожалуйста а возможно сделать так  что бы он выгружал из листа только не скрытые ячейки
27.10.2016 13:53:18
Подскажите, пожалуйста, можно ли видоизменить СПОСОБ 2 так, чтобы сохранялись листы отдельно не файлы .xls, а в файлы .txt?
10.11.2016 10:43:41
Юлия, дополнил Способ-2 про разные форматы - посмотрите, пожалуйста.
09.11.2016 20:07:40
Николай, добрый вечер!
У меня вопрос почти такой же, как у Юлии, но только про формат .pdf. Пробовал в Способе 2 менять расширение на ".pdf" - конечно, файлы создавались, но не открывались, затем пробовал прикрутить в код такую строку:

s.ExportAsFixedFormat Type:=xlTypePDF, Quality:=xlQualityMinimum, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= True
 
но ничего не получилось. Не могли бы Вы подсказать, что я делаю не так?
10.11.2016 10:26:47
Дописал Способ-5 к статье и дополнил Способ-2 про разные форматы - посмотрите, пожалуйста.
22.06.2017 16:00:14
Николай, спасибо за Вашу помощь и Ваш сайт. Я немного модифицировал макрос, чтоб он сохранял только выделенные листы. Но вышло если я выделяю один лист, он его сохраняет, а если два и больше то тогда под разными названиями сохраняет каждый раз все выделенные листы. Подскажите пожалуйста, что мне изменить, чтоб они сохранялись раздельно. Спасибо.

Sub SplitSheets5()
ActiveWorkbook.RefreshAll
   Dim s As Worksheet

   For Each s In ActiveWindow.SelectedSheets
 s.ExportAsFixedFormat Filename:="C:\doc\" & "\" & s.Name & ".pdf", Type:=xlTypePDF
   Next
End Sub
11.11.2016 20:19:11
Николай, спасибо большое за способ-5!
30.11.2016 10:54:05
Подскажите как при сохранении листа в PDF здесь задать имя файла "Имя файла, имя листа"

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
08.12.2016 09:27:42
Очень интересная статья, спасибо автору.
У меня ситуация, что нужно сохранить файл в формате (Tab delimited) *.txt
в таком случае каким будет значение File Format: ?

или примерно так:
ActiveWorkbook.SaveAs Filename:= p & "\Лист2.txt", FileFormat:= ???

Спасибо!!!
10.01.2017 12:59:41
Здравствуйте, подскажите пожалуйста, как в способе 5 добавить к названию файла кроме имени листа текстовое значение конкретной ячейки на листе (в моем случае А3)?
А также сохранение только выделенных листов в новый файл.
31.01.2017 15:23:07
Вынужден обратиться за помощью


Sub invoice()
Sheets(Array("INVOICE Nr. 0200", "Specificatie 0200", "DVI" [IMG] ).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"G:\KW 5\invoice 200.pdf", Quality:=xlQualityStandard, IncludeDocProperties _
:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub


1 можна изменить (INVOICE Nr. 0200", "Specificatie 0200", "DVI" ))на проста  (Select Sheet) выделиные листы    


2 адрес сохранения вместо (G:\KW 5\invoice 200.pdf" [IMG] в папку где находится книга с названием  PDF по ячейки с Sheet XXXX B9.

Огромнае спосибо
22.02.2017 11:53:26
Добрый день! Подскажите пожалуйста как сделать, чтоб при сохранении книги с наименованем листа, сам лист потом переименовывался по заданному слову.
Ну например была книга с листами, 1,2,3 ... сформировались книги 1,2,3 а листы в них переименовались на "Данные"
22.02.2017 14:44:45
сама разобралась добавить Worksheets(1).name="Данные"
16.03.2017 20:52:23
Поясните, пожалуйста,  как можно сразу выбрать допустим 10 файлов (книг) и разделить их на листы (все)?
Страницы: 1  2  
Наверх