Макрос для сохранения одного листа excel

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

Про сборку листов из нескольких книг в одну текущую я уже писал здесь. Теперь разберем решение обратной задачи: есть одна книга 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

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

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

• Сборка листов из нескольких книг в одну
• Что такое макросы, куда вставлять код на Visual Basic, как их использовать.

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

Wasilich Дата: Понедельник, 28.10.2013, 22:20 | Сообщение № 1 Группа: Друзья Ранг: Старожил Сообщений: 1232 Репутация: 326 ± Замечаний: 0% ± 2003 Часто встречал вопрос: — «Как сохранить лист в отдельный файл?» Вот пример сохранения сразу несколько листов и по одному. Корректировка и сокращение макросов приветствуется. К сообщению приложен файл: 7023102.xls (49.5 Kb)   Ответить

AndreTM Дата: Вторник, 29.10.2013, 02:38 | Сообщение № 2 Группа: Друзья Ранг: Старожил Сообщений: 1762 Репутация: 498 ± Замечаний: 0% ± 2003 & 2010 Я, вроде бы, там и там как раз и говорил про это. А корректировка… Ну, откорректируйте: — .InitialFileName = iPath в вашем варианте излишен. И, мне кажется, что при одиночном сохранении — подстановка имени файла в диалог более логична — .DisplayAlerts — желательно отключать/включать тогда, когда необходимо подавить сообщения, а не на всё время процедуры — Sheets(Sh.Name). <=> Sh. (не забывайте — Sheets() относится к ActiveWorkbook., так что использование коллекции без указания родителя — чревато) — Попробуйте избавиться от использования ActiveWorkbook. — Процедура массового сохранения может быть с параметром, как раз и определяющим этот ваш «конкретный» лист (или устанавливающий его на ActiveSheet) — Процедуру сохранения одного листа можно заменить на функцию с параметрами, возврат — сохраненное имя; и тогда её можно будет использовать в процедуре массового сохранения, которая будет заключаться только в переборе нужных листов — «Очистку» листа копии тоже можно сделать параметрической — ввести ещё один параметр функции, который будет определять, что именно нужно очистить на листе — И плиз, не надо месседжбоксов! А если очень надо — то просто вызовы процедур оборачиваются в дополнительный интерактив. Ведь ваше сообщение неинформативно — вы же правильность копирования нигде не проверяете. Skype: andre.tm.007 Donate: Qiwi: 9517375010 Сообщение отредактировал AndreTM — Вторник, 29.10.2013, 02:50   Ответить

RAN Дата: Вторник, 29.10.2013, 04:19 | Сообщение № 3 Группа: Друзья Ранг: Экселист Сообщений: 5645 Попробуйте избавиться от использования ActiveWorkbook А чем не нравится ActiveWorkbook, и как еще можно идентифицировать новую книгу до ее сохранения? Быть или не быть, вот в чем загвоздка!   Ответить

AndreTM Дата: Вторник, 29.10.2013, 04:44 | Сообщение № 4 Группа: Друзья Ранг: Старожил Сообщений: 1762 Репутация: 498 ± Замечаний: 0% ± 2003 & 2010 В этом методе (когда копируется один лист через .Copy без параметров) — никак. Впрочем, я же показывал: сразу после копирования — назначаем ActiveWorkbook объектной переменной. И дальше работаем исключительно с ней. В других же случаях — методы возвращают ссылку на книгу, например: [vba] Код Set NewWB = Workbooks.Add [/vba] Skype: andre.tm.007 Donate: Qiwi: 9517375010   Ответить

Wasilich Дата: Вторник, 29.10.2013, 12:53 | Сообщение № 5 Группа: Друзья Ранг: Старожил Сообщений: 1232 Репутация: 326 ± Замечаний: 0% ± 2003 А корректировка… Ну, откорректируйте: Андрей, я не себя имел ввиду. Ибо данный пример сделан на моем уровне познания VBA. И пример по теме может быть не только мой. Так что, предлагайте свои варианты.   Ответить

RAN Дата: Вторник, 29.10.2013, 22:27 | Сообщение № 6 Группа: Друзья Ранг: Экселист Сообщений: 5645 Wasilic, вариант для 1 листа [vba] Код Private Sub Save_as() 10  With Application.FileDialog(msoFileDialogSaveAs) 20      .InitialFileName = ThisWorkbook.Path & «» & «Сравнение» 30      If .Show = 0 Then Exit Sub 40      ThisWorkbook.ActiveSheet.Copy 50      Application.DisplayAlerts = False 60      .Execute 70      Application.DisplayAlerts = True 80  End With 90  ActiveWorkbook.Close False End Sub [/vba] Быть или не быть, вот в чем загвоздка!   Ответить

Wasilich Дата: Вторник, 29.10.2013, 23:40 | Сообщение № 7 Группа: Друзья Ранг: Старожил Сообщений: 1232 Репутация: 326 ± Замечаний: 0% ± 2003 Wasilic, вариант для 1 листа Спасибо Андрей. Только Ник мой убери, это ж не для меня, и цифорки из кода тоже, иначе будут вопросы — «а зачем цифры?»! Вот еще варианты в примере, в т.ч. с макросом от AndreTM если он не возражает. К сообщению приложен файл: ___2.xls (45.0 Kb)   Ответить

RAN Дата: Среда, 30.10.2013, 00:23 | Сообщение № 8 Группа: Друзья Ранг: Экселист Сообщений: 5645 Любой каприз …. Вариант для 1 листа [vba] Код Private Sub Save_as()     With Application.FileDialog(msoFileDialogSaveAs)         .InitialFileName = ThisWorkbook.Path & «» & «Сравнение»         If .Show = 0 Then Exit Sub         ThisWorkbook.ActiveSheet.Copy         Application.DisplayAlerts = False         .Execute         Application.DisplayAlerts = True     End With     ActiveWorkbook.Close False End Sub [/vba] Быть или не быть, вот в чем загвоздка! Сообщение отредактировал RAN — Среда, 30.10.2013, 00:25   Ответить

RAN Дата: Среда, 30.10.2013, 00:33 | Сообщение № 9 Группа: Друзья Ранг: Экселист Сообщений: 5645 Wasilic, лучше выкладывай коды, а не файлы. Файл качать надо, а по коду сразу может быть понятно — не то. Файлы — бонус. Быть или не быть, вот в чем загвоздка!   Ответить

Wasilich Дата: Среда, 30.10.2013, 01:33 | Сообщение № 10 Группа: Друзья Ранг: Старожил Сообщений: 1232 Репутация: 326 ± Замечаний: 0% ± 2003 Файл качать надо, а по коду сразу может быть понятно — не то. Это нам с тобой просто, посмотрел и понятно. А тем кто знает, что «никто не знает» — сложновато будет. А, в фале оно уже как бы и работает. ИМХО.   Ответить

AndreTM Дата: Среда, 30.10.2013, 02:47 | Сообщение № 11 Группа: Друзья Ранг: Старожил Сообщений: 1762 Репутация: 498 ± Замечаний: 0% ± 2003 & 2010 от AndreTM если он не возражает Нэ вазражайу (с) К сообщению приложен файл: 0748227.jpg (11.4 Kb) Skype: andre.tm.007 Donate: Qiwi: 9517375010   Ответить

DAKRAY Дата: Четверг, 09.01.2014, 18:19 | Сообщение № 12 Группа: Пользователи Ранг: Участник Сообщений: 73 Репутация: 1 ± Замечаний: 0% ± Excel 2003 Всем добрый. В приложении еще один простенький вариант сохранения. Изначальный код мне скинул antal10, переделал под свои нужды. [vba] Код Private Sub SaveSheets_Click() Dim Fname As String      Application.ScreenUpdating = False      Fname = ThisWorkbook.Path & «» & Sheets(«Sheet1»).Range(«A1″).Value & » » & Range(«B1»).Text & «.xls» ‘тут название файла состоит из названия фирмы и нр. счета      Sheets(Array(«Sheet1», «Sheet2»)).Copy ‘указываем листы, которые хотим оставить      Sheets(«Sheet1»).Shapes(«SaveSheets»).Delete ‘удаляем ненужные кнопки (в моем случае у меня есть кнопки, которые должны остаться)      With ActiveWorkbook           Application.DisplayAlerts = False           .SaveAs Filename:=Fname           Application.ScreenUpdating = True           Application.DisplayAlerts = True           ‘.Close      End With      Workbooks(«Book_Save.xls»).Close 0 End Sub [/vba] П.С. Только вот никак не получается сделать так, чтобы модуль (функция) тоже копировался в новую книгу. Там у меня сумма прописью. Можно в принципе и значение только копировать, не обязательно с модулем — как проще. Если не сложно help подскажите!)   Ответить

shebelme Дата: Понедельник, 06.10.2014, 08:05 | Сообщение № 13 Группа: Пользователи Ранг: Прохожий Сообщений: 2 Репутация: 0 ± Замечаний: 0% ± Excel 2007 Прошу вашей помощи! Подскажите как изменить код таким образом, что бы был прописан конкретный адрес для сохранения нового файла, а не ручной выбор. За ранее спасибо!   Ответить

Wasilich Дата: Среда, 08.10.2014, 00:21 | Сообщение № 14 Группа: Друзья Ранг: Старожил Сообщений: 1232 Репутация: 326 ± Замечаний: 0% ± 2003 изменить код таким образом, что бы был прописан конкретный адрес Так попробуйте. [vba] Код Sub Лист_в_файл() ‘Сохранить текущий лист.      Dim List$, iPath$          iPath = «D:Папкапапка» ‘ конкретный адрес для сохранения нового файла          Application.ScreenUpdating = False      Application.DisplayAlerts = False      List = ActiveSheet.Name      Sheets(List).Copy      Sheets(List).UsedRange.Value = Sheets(List).UsedRange.Value      Sheets(List).Buttons.Delete ‘Удаляем кнопки      ‘Sheets(List).DrawingObjects.Delete ‘Удаляем все элементы      ActiveWorkbook.SaveAs iPath & List ‘& «.xls»      ActiveWorkbook.Close False      Application.DisplayAlerts = True      Application.ScreenUpdating = True      MsgBox «Готово!»   End Sub [/vba]   Ответить

Ферхо Дата: Воскресенье, 07.12.2014, 14:28 | Сообщение № 15 Группа: Пользователи Ранг: Новичок Сообщений: 10 Репутация: 1 ± Замечаний: 0% ± Excel 2010 Не претендую ни на что, просто я делаю так (возможно кому-то пригодится идея) [vba] Код ‘сохранить лист в отдельном файле ‘sSheetName — имя сохраняемого листа (если такого нет — ни чего не делается) ‘sNewFileName — имя файла (если не задано — берется имя листа) ‘sNewPath — куда сохраняем, если не задано, в текущую ‘sRngDelList — если надо указываем диапазоны столбцов для удаления ‘bDelFurmula — если указано — удаляем формулы и ссылки ‘sSubRun — если нужна дополнительная обработка — укажим нужную процедуру Function fnSheetsSave(ByVal sSheetName As String, _                          Optional ByVal sNewFileName As String = «», _                          Optional ByVal sNewPath As String = «», _                          Optional ByVal sRngDelList As String = «», _                          Optional ByVal bDelFurmula As Boolean = False, _                          Optional ByVal sSubRun As String = «») As Boolean                     Dim sFullFileName As String, arDelCol, iI As Integer, sCol As String Dim strPS As String: strPS = Application.PathSeparator      fnSheetsSave = False      If Not fnSheetsIsExist(sSheetName) Then Exit Function            TRC.Pop «fnSheetsSave»      TRC.INFO «Сохранение листа в отдельную книгу», eColorBloc            If sNewFileName = «» Then sNewFileName = sSheetName        mChkPath:      ‘проверим и если что, сформируем путь      If sNewPath = «» Then          sNewPath = ActiveWorkbook.path & strPS      Else          If Right(sNewPath, 1) <> strPS Then sNewPath = sNewPath & strPS          If Not fnPathIsExists(sNewPath) Then              sNewPath = «»              GoTo mChkPath          End If      End If            ‘создаем полный путь к новому файлу      sFullFileName = sNewPath & sNewFileName & IIf(fnGetFileExt(sNewFileName) = «», «.xls», «»)            ‘возможен долгий процесс, поэтому      ‘дадим возможность поработать другим      DoEvents            On Error Resume Next      ‘создаем копию листа…      ‘создается новая книга и она становится активной      ThisWorkbook.Sheets(sSheetName).Copy      TRC.NOERROR «Лист скопирован в новую книгу (» & sSheetName & «)»      If TRC.IFERROR(«ОШИБКА копирования листа (» & sSheetName & «) %1») Then GoTo lEXITfnSheetsSave      ‘после возможно долгого процесса      ‘дадим возможность поработать другим      DoEvents            Application.ScreenUpdating = False            If bDelFurmula = True Then          ‘убираем ссылки и формулы          ActiveSheet.Range(«A1»).CurrentRegion.Value = ActiveSheet.Range(«A1»).CurrentRegion.Value          TRC.INFO «Формулы удалены»      End If            ‘однозначно убираем перенос по словам      ActiveSheet.Range(«A1»).CurrentRegion.WrapText = False            ‘если указаны столбцы на удаление — удалим их      If sRngDelList <> «» Then          arDelCol = Split(sRngDelList, » «)          For iI = 0 To UBound(arDelCol)              sCol = arDelCol(iI)              ActiveSheet.Range(sCol).Delete          Next iI          TRC.INFO «Столбцы удалены (» & sRngDelList & «)»      End If            ‘если указана дополнительная функция для обработки — выполним ее      If sSubRun <> «» Then          Application.Run sSubRun          TRC.INFO «Функция дополнительной обработки выполнена (» & sSubRun & «)»      End If            ‘сохраняем файл со всеми изменениями      ActiveWorkbook.SaveCopyAs sFullFileName      ActiveWorkbook.Close SaveChanges:=False      TRC.NOERROR «Новая книга сохранена (» & sFullFileName & «)»      If TRC.IFERROR(«ОШИБКА! Книга не сохранена (» & sFullFileName & «) %1») Then GoTo lEXITfnSheetsSave            fnSheetsSave = True        lEXITfnSheetsSave:      Application.ScreenUpdating = True            TRC.Push End Function [/vba] Если очень хочется, то можно! 2B|`2B?   Ответить

kbcgv Дата: Суббота, 10.01.2015, 15:54 | Сообщение № 16 Группа: Пользователи Ранг: Прохожий Сообщений: 2 Репутация: 0 ± Замечаний: 20% ± Excel 2010 Wasilic, вариант для 1 листа Private Sub Save_as() 10 With Application.FileDialog(msoFileDialogSaveAs) 20 .InitialFileName = ThisWorkbook.Path & «» & «Сравнение» 30 If .Show = 0 Then Exit Sub 40 ThisWorkbook.ActiveSheet.Copy 50 Application.DisplayAlerts = False 60 .Execute 70 Application.DisplayAlerts = True 80 End With 90 ActiveWorkbook.Close False End Sub Пригодился идеально ваш код. Спасибо. Попытался из него сделать надстройку. Чтобы добавить ссылку на макрос в панель быстрого запуска эксель. Сохранив его в формате надстройки. В этом случае не работает, только из этого же файла. Подскажите пожалуйста как его сделать для надстройки. В нём имя изменил, для того чтобы формировал имя из ячеек на листе. [vba] Код Sub Save_as() 10 With Application.FileDialog(msoFileDialogSaveAs) 20 .InitialFileName = [b3] & » » & [b8] 30 If .Show = 0 Then Exit Sub 40 ThisWorkbook.ActiveSheet.Copy 50 Application.DisplayAlerts = False 60 .Execute 70 Application.DisplayAlerts = True 80 End With 90 ActiveWorkbook.Close False End Sub [/vba] [moder]Оформляйте коды тегами Кнопка #[/moder] Сообщение отредактировал DJ_Marker_MC — Суббота, 10.01.2015, 16:28   Ответить

RAN Дата: Суббота, 10.01.2015, 16:44 | Сообщение № 17 Группа: Друзья Ранг: Экселист Сообщений: 5645 формировал имя из ячеек на листе. В отличие от макроса из #15, этот макрос не может в принципе. Для того, чтобы работал из надстройки, нужно так [vba] Код 40 ActiveWorkbook.ActiveSheet.Copy [/vba] Быть или не быть, вот в чем загвоздка!   Ответить

kbcgv Дата: Суббота, 10.01.2015, 17:32 | Сообщение № 18 Группа: Пользователи Ранг: Прохожий Сообщений: 2 Репутация: 0 ± Замечаний: 20% ± Excel 2010 В отличие от макроса из #15, этот макрос не может в принципе. Не может делать имя из ячеек? Я в этом ничего практически не понимаю, методом тыка всё. Именно из ячееек b3 и b8 и делает имя. И всё как хотелось работает в виде надстройки, благодаря: Для того, чтобы работал из надстройки, нужно так 40 ActiveWorkbook.ActiveSheet.Copy Спасибо.   Ответить

AVI Дата: Среда, 07.09.2016, 05:36 | Сообщение № 19 Группа: Проверенные Ранг: Ветеран Сообщений: 523 Репутация: 17 ± Замечаний: 0% ± Excel 2016 Добрый день! Как сделать так, что бы при сохранении файла удалялись 5 первых столбцов? И как при сохранении можно самостоятельно называть файл? Сообщение отредактировал AVI — Среда, 07.09.2016, 05:39   Ответить

китин Дата: Среда, 07.09.2016, 07:20 | Сообщение № 20 Группа: Модераторы Ранг: Экселист Сообщений: 6973 Репутация: 1063 ± Замечаний: 0% ± Excel 2007;2010;2016 правила прочитать и задать вопрос в соответствующей теме Не судите очень строго:я пытаюсь научиться ЯД 41001877306852   Ответить

This Excel Macro saves the currently visible worksheet into the SAME folder as the current file. It is different from the other Save Worksheet macros because the other ones require you to specify a hard-coded location for where the new file will be saved.

Just to repeat, this macro puts the new file into the same folder as where the current file is located. This is important so you don’t waste time wondering where the new Excel file is located.

Sub Save_Worksheet_as_New_File_in_Current_Folder()
    
    'Gets the name of the currently visible worksheet
    Filename = ActiveSheet.Name
    
    'Copys the visible worksheet to a new workbook
    ThisWorkbook.ActiveSheet.Copy
   
    'Saves the new Excel file
    ActiveWorkbook.SaveAs Filename & ".xlsx"
    
    'Closes the newly created workbook so you are still looking at the original workbook
    ActiveWorkbook.Close

End Sub

As usual, the code above is heavily commented and should be pretty easy to understand once you copy it into a module in your workbook.

To change the name of the new file, simply change ActiveSheet.Name to whatever you want, hard-coded text, a date or time, or a combination of all of the above. Currently, the new file will have the name of the sheet that is being used to create it.

That’s about it. There’s not so much to change with this macro.

I hope this helps!

---

Сохранить лист в файл в vba excel

В приложении еще один простенький вариант сохранения.
Изначальный код мне скинул antal10, переделал под свои нужды.

П.С. Только вот никак не получается сделать так, чтобы модуль (функция) тоже копировался в новую книгу. Там у меня сумма прописью. Можно в принципе и значение только копировать, не обязательно с модулем — как проще. Если не сложно help подскажите!)

200?’200px’:»+(this.scrollHeight+5)+’px’);»> Sub Лист_в_файл() ‘Сохранить текущий лист.
Dim List$, iPath$

iPath = «D:Папкапапка» ‘ конкретный адрес для сохранения нового файла

Application.ScreenUpdating = False
Application.DisplayAlerts = False
List = ActiveSheet.Name
Sheets(List).Copy
Sheets(List).UsedRange.Value = Sheets(List).UsedRange.Value
Sheets(List).Buttons.Delete ‘Удаляем кнопки
‘Sheets(List).DrawingObjects.Delete ‘Удаляем все элементы
ActiveWorkbook.SaveAs iPath & List ‘& «.xls»
ActiveWorkbook.Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox «Готово!»
End Sub

Не претендую ни на что, просто я делаю так (возможно кому-то пригодится идея)

200?’200px’:»+(this.scrollHeight+5)+’px’);»>
‘сохранить лист в отдельном файле
‘sSheetName — имя сохраняемого листа (если такого нет — ни чего не делается)
‘sNewFileName — имя файла (если не задано — берется имя листа)
‘sNewPath — куда сохраняем, если не задано, в текущую
‘sRngDelList — если надо указываем диапазоны столбцов для удаления
‘bDelFurmula — если указано — удаляем формулы и ссылки
‘sSubRun — если нужна дополнительная обработка — укажим нужную процедуру
Function fnSheetsSave(ByVal sSheetName As String, _
Optional ByVal sNewFileName As String = «», _
Optional ByVal sNewPath As String = «», _
Optional ByVal sRngDelList As String = «», _
Optional ByVal bDelFurmula As Boolean = False, _
Optional ByVal sSubRun As String = «») As Boolean

Dim sFullFileName As String, arDelCol, iI As Integer, sCol As String
Dim strPS As String: strPS = Application.PathSeparator

If Not fnSheetsIsExist(sSheetName) Then Exit Function

TRC.Pop «fnSheetsSave»
TRC.INFO «Сохранение листа в отдельную книгу», eColorBloc

If sNewFileName = «» Then sNewFileName = sSheetName

mChkPath:
‘проверим и если что, сформируем путь
If sNewPath = «» Then
sNewPath = ActiveWorkbook.path & strPS
Else
If Right(sNewPath, 1) <> strPS Then sNewPath = sNewPath & strPS
If Not fnPathIsExists(sNewPath) Then
sNewPath = «»
GoTo mChkPath
End If
End If

‘создаем полный путь к новому файлу
sFullFileName = sNewPath & sNewFileName & IIf(fnGetFileExt(sNewFileName) = «», «.xls», «»)

‘возможен долгий процесс, поэтому
‘дадим возможность поработать другим
DoEvents

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

Разберем код макроса, который позволяет скопировать все листы книги и сохранить их в отдельные файлы в Excel.

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

Как сохранить лист Excel в отдельный файл?

Для сохранения листа в отдельную книгу можно воспользоваться стандартными средствами Excel.
Нажимаем правой кнопкой мыши по имени листа в нижней панели и выбираем Переместить/скопировать:

Далее перемещаем лист в новую книгу, сохраняем её и даем название файлу.
Однако в случае большого количества листов, которые нужно сохранить, эта процедура может занять достаточно большое количество времени.
Если предположить, что на сохранение каждого листа тратится по 30 секунд, то для книги из 20 листов мы уже потратим 10 минут.
Поэтому, чтобы иметь возможность быстро сохранить листы в отдельные файлы воспользуемся возможностями VBA и напишем макрос для сохранения листов, который позволит производить эти действия за несколько секунд.

Макрос сохранения листа Excel в файл

Переходим в редактор Visual Basic, для этого в панели вкладок выбираем Разработчик -> Visual Basic (или воспользуемся сочетанием клавиш Alt + F11).
Создаем новый модуль и записываем в него макрос (как обычно, напротив каждой строчки дается пояснение к коду):

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

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

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

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

Способ 1. Простое разделение

Нажмите сочетание Alt+F11 или выберите в меню Сервис — Макрос — Редактор Visual Basic (Tools — Macro — Visual Basic Editor) , вставьте новый модуль через меню Insert — Module и скопируйте туда текст этого макроса:

Если теперь выйти из редактора Visual Basic и вернуться в Excel, а затем запустить наш макрос (Alt+F8), то все листы из текущей книги будут разбиты по отдельным новым созданным книгам.

Способ 2. Разделение с сохранением

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

Этот макрос сохраняет новые книги-листы в ту же папку, где лежал исходный файл. При необходимости сохранения в другое место, замените wb.Path на свой путь в кавычках, например «D:Отчеты2012» и т.п.

Если нужно сохранять файлы не в стандартном формате книги Excel (xlsx), а в других (xls, xlsm, xlsb, txt и т.д.), то кроме очевидного изменения расширения на нужное, потребуется добавить еще и уточнение формата файла — параметр FileFormat:

Для основных типов файлов значения параметра FileFormat следующие:

• XLSX = 51
• XLSM = 52
• XLSB = 50
• XLS = 56
• TXT = 42

Полный список всех вариантов можно посмотреть в справке MSDN.

Способ 3. Сохранение в новые книги только выделенных листов

Если вы хотите раскидать по файлам не все листы в вашей книге, а только некоторые, то макрос придется немного изменить. Выделите нужные вам листы в книге, удерживая на клавиатуре клавишу Ctrl или Shift и запустите приведенный ниже макрос:

Создавать новое окно и копировать через него, а не напрямую, приходится потому, что Excel не умеет копировать группу листов, если среди них есть листы с умными таблицами. Копирование через новое окно позволяет такую проблему обойти.

Способ 4. Сохранение только выделенных листов в новый файл

Во всех описанных выше способах каждый лист сохранялся в свой отдельный файл. Если же вы хотите сохранить в отдельный новый файл сразу группу выделенных предварительно листов, то нам потребуется слегка видоизменить наш макрос:

Способ 5. Сохранение листов как отдельных PDF-файлов

Нужный нам код будет выглядеть следующим образом:

Способ 6. Готовый макрос из надстройки PLEX

Если лень или нет времени внедрять все вышеописанное, то можно воспользоваться готовым макросом из моей надстройки PLEX:

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

Макрос сохранение активного листа книги в отдельный файл
Код сохраняет файл, но с пустым содержанием. Подскажите, в чем может быть проблема? With.

Сохранение листа книги в отдельный файл в альбомном виде
Добрый день! Есть данный макрос, он сохраняет лист из книги в отдельный файл, но не совсем так как.

Сохранение книги как отдельный файл
Коллеги, доброго дня. Подскажите советом — нахожусь на развилке между удобством и автоматизацией.

Сохранение текущего листа Excel в отдельный файл
Доброго всем времени суток! Помогите справиться с небольшой проблемкой. Есть файл Excel с.

Сохранение листа книги в файле — проблема с защитой листа и привязкой макросов
С толкнулся с такой проблемой при сохранении листа в файле вот код который сохраняет лист в.

Klim_ul, давай для начала с разделом определимся — это VB6 или VBA(Excel)?

Где такая кнопка есть — на форме, на листе, в тулбаре?

Отдельно от самой книги. например открыта Книга.xls состоящая из 3-х листов, далее на каждом из листов ввели какую либо информацию. Мне нужно сохранить только лишь Лист3 из этой книги, как отдельный файл.xls название которого будет текущая дата.

Добавлено через 2 минуты
Это VBA(Excel)! А кнопку создаем сами CommandButton и привязываем Макрос!

Добавлено через 40 секунд
Кнопка на листе!

Добавлено через 43 секунды
Апострофф, Буду оч. благодарен за помощь!

Огромное Всем спасибо.

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

Плохо, когда ноги с головой не дружат:D

Спасибо! Это мой первый опыт в VBA. Не судите строго!
Не подскажите, сложно ли сделать так, чтобы все выражения в скопированных листах были сохранены как значения?

Добавлено через 49 минут
В коде ниже сохранять как значение, если использовать массивы не получается:

Вот это почти похоже на правду. То что удаляет все за областью печати — это не страшно. При сохранении можно указать путь и имя, и что сохраняет значения, а не формулы — это все то что надо. Только как бы немного доработать, чтобы сохранялся не выделенный лист, а к примеру так: на первом листе будут какие-то расчеты и кнопка сохранить, а таблицы с результатами на втором и третьем листе. И вот при нажатии на кнопку сохранить, сохранялись бы второй и третий листы в отдельной книге.

Добавлено через 2 часа 30 минут
DanAttess, А можно увидеть файл с результатом сохранений?

Макрос сохранения листа Excel в файл

Данный макрос позволяет упростить процедуру сохранения активного листа в книге Excel в отдельный файл.

Для использования этого макроса на любом листе в книге Excel создайте кнопку, и назначьте ей макрос СохранитьЛистВФайл.

При запуске макроса (нажатии кнопки) будет выведено диалоговое окно выбора имени для сохраняемого файла, после чего текущий лист будет сохранён под заданным именем в выбранной папке.

Сохранение производится в формате XLS (формат Excel 2003)
Если пользователь отказался от ввода имени файла (нажал клавишу ESC или кнопку «Отмена» в диалоговом окне),
то сохранения листа в файл не происходит.

PS: Кто-то может сказать, что для сохранения листа в файл в объектной модели Excel есть метод SaveAs, применимый к объекту Worksheet.

Но, как ни странно, выполнение кода ActiveSheet.SaveAs » « приводит к сохранению книги целиком, что равносильно использованию кода ActiveWorkbook.SaveAs » «

Почему этот метод сохранения работает так нелогично — лично мне не понятно (видимо, Microsoft что-то там перемудрил)

• 145580 просмотров

Комментарии

Спасибо. Разобрался. Нашёл ошибки в библиотеках.)

Спасибо. Всё запустил, но не работает. Пишет не найден проект или библиотека. Простите, не уточнил, поменял ещё саму систему (был XP стал Win7 x64).
Вот мой код:
Private Sub CommandButton2_Click()
On Error Resume Next
Const REPORTS_FOLDER = «C:Users. . . »
MkDir ThisWorkbook.Path & «» & REPORTS_FOLDER
ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path & «» & REPORTS_FOLDER
FileName = [b8] & «_» & [b6] & «_» & [b4] & «_» & Format([b2], «DDMMMMYY») & «_» & [c2] & «.xlsx»
Err.Clear: Worksheets(Array(. «, «. «)).Copy: DoEvents
If Err Then Exit Sub
If ActiveWorkbook.Worksheets.Count = 2 And ActiveWorkbook.Path = «» Then
ActiveWorkbook.SaveAs FileName, xlWorkbookNormal
ActiveWorkbook.Close False
End If
End Sub

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

> найти файл с макросами в папке
> щелкнуть правой кнопкой мыши на файле — Свойства — Разблокировать — ОК
> и только после этого запускать

Перешёл с 2007 на Office 2016, перестали работать макросы. И этот. (((

Добрый день, подскажите, пожалуйста, что надо изменить в макросе, чтобы:
1. Он копировал не весь лист целеком, а только диапазон ВИДИМЫХ ячеек (A1:L50), т.к. этот диапазон только часть отфильтрованного списка.
2. Он копировал только значения, без формул ячеек.

Здравствуйте, Алексей
Да, можно такое сделать, — могу написать макрос под заказ.

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

Можете написать макрос под заказ? Мне надо до понедельника

Напишите ваши контакты, есть несколько задач.

Дмитрий, можем сделать вам макрос под заказ.
Оформляйте заказ, прикрепляйте файл (в который надо встроить макрос), и подробно описывайте, что куда в каком виде и под каким именем сохранять.

Дело в том, что в книге порядка 20-30 листов и каждый лист необходимо сохранить в отдельные папки, соответствующие имени листа.

Дмитрий, а куда уж проще-то. вы нажимаете одну кнопку «Печать», и получаете готовый файл JPG
Зачем ещё-то упрощать.
Можно, конечно, и макрос под заказ написать
Если в формат BMP (или EMF) картинку сохранять — то макрос несложный, если в формат JPG — то макрос сложнее будет (и дороже)
Но я бы на вашем месте не стал изобретать велосипед, а оставил бы все как есть.

Сохраняю листы в JPEG формате, при помощи виртуального принтера «universal document converter» возможно ли упростить процедуру сохранения активного листа?

Здравствуйте, Игорь. Будьте любезны, взгляните на код. Основная часть была взята с другого сайта, часть с Вашего. Суть такая: на первом листе исходные данные и кнопка, на третьем — расчеты с формулами. Необходимо чтобы при нажатии кнопки создавалась папка «Двери» в текущей папке, где лежит этот файл (а если она есть, то сохранялось в нее), а имя файла бралось с листа 1 из ячеек a17 & b17. Сохраняться должен третий лист (он скрыт), формулы на нем заменить на значения. После сохранения новая книга закрывается и выводится сообщение об удачном сохранении файла с именем из ячеек a17 & b17. Сам я методом тыка пытался воплотить это, но лист не хочет сохраняться с указанным именем (используется имя по умолчанию «Книга 2. Книга 3. ). Также непонятно мне как сделать чтобы выскакивало сообщение о результате сохранения. Подскажите пожалуйста.

On Error Resume Next
Const REPORTS_FOLDER = «Двери»
‘ название подпапки, в которую по-умолчанию будет предложено сохранить файл

MkDir ThisWorkbook.Path & «» & REPORTS_FOLDER
‘ создаём папку для файла, если её ещё нет

ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path & «» & REPORTS_FOLDER
‘ выбираем стартовую папку

Filename = Range(«a17») & («b17») & «.xls»
‘ вывод диалогового окна для запроса имени сохраняемого файла

If VarType(Filename) = vbBoolean Then Exit Sub
‘ если пользователь отказался от выбора имени файла — отменяем сохранение листа в файл

Dim Ar(), ArAll&(), Sh As Excel.Worksheet, n

Select Case Sheets(1).[Условие]
Case 1
Ar = Array(3)
Case Else
End Select

ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count — 1)
For Each Sh In ThisWorkbook.Worksheets
ArAll(n) = Sh.Index
n = n + 1
Next
ThisWorkbook.Worksheets(ArAll).Copy
Application.Volatile
Application.Calculate
Application.ScreenUpdating = False
For Each n In Ar
With ActiveWorkbook.Worksheets(n).UsedRange.Cells
.Value = .Value
End With
Next
Erase ArAll: n = 0
ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count — 1 — (UBound(Ar) + 1))
For Each Sh In ActiveWorkbook.Worksheets
If IsError(Application.Match(Sh.Index, Ar, 0)) Then
ArAll(n) = Sh.Index
n = n + 1
Else: If Sh.Visible = False Then Sh.Visible = True
End If
Next
ActiveWorkbook.Sheets(Ar(0)).Activate
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets(ArAll).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Dialogs(xlDialogSaveAs).Show

ActiveWorkbook.Close False
End Sub

Dim WB As Workbook
Dim ind As Integer
ind = ActiveSheet.Index
Application.DisplayAlerts = False
Set WB = Workbooks.Add
Dim li As Long
Application.DisplayAlerts = False
ind = 3
For n = ind To 2 Step -1
ThisWorkbook.Sheets(n).Copy Before:=WB.Sheets(1)
Next

pdfFilename = Application.DefaultFilePath & Application.PathSeparator & «имя файла» & Range(«D9»).Value & «.pdf»
WB.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=pdfFilename, OpenAfterPublish:=False

При этом файл создается с названием «имя файла.pdf» начисто игнорируя содержимое ячейки указанной.

Вот макрос, который сохраняет без ограничения 255-ти символов в ячейке:

---

---

---

---

---

---

---

---

---

---

---

---

---

---

---

---

---

---

---

Данный макрос позволяет упростить процедуру сохранения активного листа в книге Excel в отдельный файл.

Для использования этого макроса на любом листе в книге Excel создайте кнопку, и назначьте ей макрос СохранитьЛистВФайл.

При запуске макроса (нажатии кнопки) будет выведено диалоговое окно выбора имени для сохраняемого файла, после чего текущий лист будет сохранён под заданным именем в выбранной папке.

Сохранение производится в формате XLS (формат Excel 2003)
Если пользователь отказался от ввода имени файла (нажал клавишу ESC или кнопку «Отмена» в диалоговом окне),
то сохранения листа в файл не происходит.

Sub СохранитьЛистВФайл()

On Error Resume Next

‘ название подпапки, в которую по-умолчанию будет предложено сохранить файл

Const REPORTS_FOLDER = «Отчёты»

‘ создаём папку для файла, если её ещё нет

MkDir ThisWorkbook.Path & «» & REPORTS_FOLDER

‘ выбираем стартовую папку

ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path & «» & REPORTS_FOLDER

‘ вывод диалогового окна для запроса имени сохраняемого файла

Filename = Application.GetSaveAsFilename(«отчёт.xls», «Отчёты Excel (*.xls),», , _

«Введите имя файла для сохраняемого отчёта», «Сохранить»)

‘ если пользователь отказался от выбора имени файла — отменяем сохранение листа в файл

If VarType(Filename) = vbBoolean Then Exit Sub

‘ копируем активный лист (при этом создаётся новая книга)

Err.Clear: ActiveSheet.Copy: DoEvents

If Err Then Exit Sub ‘ произошла какая-то ошибка при попытке копирования листа

‘ убеждаемся, что активной книгой является копия листа

If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = «» Then

‘ сохраняем файл под заданным именем в формате Excel 2003

ActiveWorkbook.SaveAs Filename, xlWorkbookNormal

‘ закрываем сохранённый файл

‘ (удалите следующую строку, если закрывать созданный файл не требуется)

ActiveWorkbook.Close False

End If

End Sub

PS: Кто-то может сказать, что для сохранения листа в файл в объектной модели Excel есть метод SaveAs, применимый к объекту Worksheet.

Но, как ни странно, выполнение кода ActiveSheet.SaveAs «<имя файла>» приводит к сохранению книги целиком, что равносильно использованию кода ActiveWorkbook.SaveAs «<имя файла>»

Почему этот метод сохранения работает так нелогично — лично мне не понятно (видимо, Microsoft что-то там перемудрил)

• 122005 просмотров