Vba 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   Ответить

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

​Смотрите также​​: Добрый день, господа!​Перерыл кучу литературы​ Workbook Dim sh​ в заданном формате.​Помогите справиться с​ в ячейку листа,​lEXITfnSheetsSave:​ Then Exit Function​’.Close​ листа​ откорректируйте:​ все листы в​

​ для каждого листа​​ так: на первом​​Будет ли работать:​​ меня сохраняет в​Klim_ul​Помогите создать макрос,​ и нигде не​
​ As Worksheet Dim​Abu​ небольшой проблемкой.​ например в А1​
​Application.ScreenUpdating = True​TRC.Pop «fnSheetsSave»​

​End With​​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Private Sub Save_as()​-​ вашей книге, а​ выполнить немаленькую цепочку​ листе будут какие-то​ThisWorkbook.Sheets(2).Copy ThisWorkbook.Sheets(3).Copy ActiveWorkbook.SaveCopyAs​ текущую директорию, а​: Процедура по нажатию​ для того чтобы​ нашёл.​ DateString As String​: так вроде спрашивалось​Есть файл Excel​
​Код200?’200px’:»+(this.scrollHeight+5)+’px’);»>newName = Sheets(Sh.Name).Cells(1,​TRC.Push​TRC.INFO «Сохранение листа​Workbooks(«Book_Save.xls»).Close 0​
​10With Application.FileDialog(msoFileDialogSaveAs)​
​.InitialFileName = iPath​
​ только некоторые, то​
​ действий (выбрать лист,​​ расчеты и кнопка​ FileN ?​

​ мне нужно указать​​ кнопки-сохранить к примеру​ собрать(скопировать) листы из​Короче, нужно сохранить​ Dim FolderName As​Мне диалог в​ с несколькими листами.​ 1)​End Function​ в отдельную книгу»,​End Sub​20.InitialFileName = ThisWorkbook.Path​в вашем варианте​ макрос придется немного​ правой кнопкой по​ сохранить, а таблицы​vhow4ik​ другой путь!​ лист3 из текущей​ разных файлов Excel​ web-страничку, например http://www.yandex.ru/​

​ String Application.EnableEvents =​​ голову и пришёл​ Сделал ToolBar с​’…​kbcgv​ eColorBloc​
​П.С. Только вот​ & «» &​ излишен. И, мне​ изменить. Выделите нужные​ ярлычку листа, выбрать​ с результатами на​: ThisWorkbook.Sheets(Array(2, 3)).Copy ActiveWorkbook.SaveCopyAs​Апострофф​ книги как отдельный​ в один файл​на винт в​ False Set WbMain​P.S. сохраняет и​

​ кнопками. Как реализовать​​ActiveWorkbook.SaveAs iPath &​: Пригодился идеально ваш​If sNewFileName =​ никак не получается​ «Сравнение»​ кажется, что при​ вам листы в​Копировать​ втором и третьем​ FileN​:​

​ файл.xls с названием​​ Excel.​
​ файл формата .htm​ = ActiveWorkbook FolderName​ вправду всю книгу,​ кнопку «Сохранить как»​ newName ‘& «.xls»​ код. Спасибо.​ «» Then sNewFileName​ сделать так, чтобы​30If .Show =​

​ одиночном сохранении -​​ книге, удерживая на​​, указать отдельный предварительно​​ листе. И вот​
​DanAttess​​Апострофф​ текущей даты в​Вводная информация:​
​ , прямо из​ = WbMain.Path &​
​ но других вариантов​​ только для текущего​

​AVI​​Попытался из него​​ = sSheetName​​ модуль (функция) тоже​ 0 Then Exit​ подстановка имени файла​ клавиатуре клавишу Ctrl​ созданный пустой файл​ при нажатии на​, а почитать, что​, p = ThisWorkbook.Path​ отдельную папку. А​1. Все собираемые​ Excel при этом​ «Archive» On Error​ чё то не​ листа. т. е.​: А если мне​
​ сделать надстройку. Чтобы​mChkPath:​
​ копировался в новую​ Sub​ в диалог более​ или Shift и​ и т.д.) Гораздо​ кнопку сохранить, сохранялись​Diskretor​Diskretor​ также если файл​ листы имеют одинаковые​ не открывая Эксплорер​ Resume Next MkDir​ придумалось​ чтобы при нажатии​

​ нужно присвоить любое​​ добавить ссылку на​’проверим и если​ книгу. Там у​40ThisWorkbook.ActiveSheet.Copy​​ логична​​ запустите приведенный ниже​

​ проще использовать короткий​

​ бы второй и​постом выше написал​

​, FileN = ThisWorkbook.Path​ с таким названием​ имена, при копировании​ и не загружая​

​ FolderName If ActiveSheet.Visible​​Vlanib​​ на кнопку можно​​ имя?​ макрос в панель​
​ что, сформируем путь​ меня сумма прописью.​50Application.DisplayAlerts = False​-​ макрос:​ макрос, автоматизирующий эти​ третий листы в​
​ не судьба?​ & «» &​ уже существует, тогда​ имя листа =​
​ никуда эту страницу.​ = -1 Then​: Так я и​ было выбрать директорию​Manyasha​ быстрого запуска эксель.​If sNewPath =​ Можно в принципе​60.Execute​.DisplayAlerts​Sub SplitSheets3() Dim​ действия.​ отдельной книге.​Ваш код создаст​ Date & «.xls»​
​ перезаписать! Подскажите пожалуйста!​ имени книги с​Подозреваю, что без​ ActiveSheet.Copy Set Wb​ говорю, в Excel​ и имя файла,​:​ Сохранив его в​ «» Then​ и значение только​

​70Application.DisplayAlerts = True​​- желательно отключать/включать​ AW As Window​Нажмите сочетание​
​DanAttess​
​ две новые книги​ThisWorkbook.Path меняете на,​

​ Заранее спасибо!​​ которой копируется лист​ API не обойтись.​​ = ActiveWorkbook Wb.SaveAs​​ есть прекрасный метод​​ и текущий лист​​AVI​ формате надстройки. В​
​sNewPath = ActiveWorkbook.path​ копировать, не обязательно​80End With​ тогда, когда необходимо​ Set AW =​

​Alt+F11​​, А можно увидеть​ с одним листом​ например, «C:temp»​Апострофф​
​2. Все файлы​HELP PLEASE​ FolderName _ &​ для получения имени​ сохранялся бы в​, на примере макроса​
​ этом случае не​ & strPS​ с модулем -​90ActiveWorkbook.Close False​
​ подавить сообщения, а​ ActiveWindow For Each​или выберите в​

​ файл с результатом​​ в каждой, причём​KoGG​:​ находятся в одной​Заранее благодарен.Ну, типа​ «» & Wb.Sheets(1).Name​ файла с помощью​ отдельный файл (.html​ Лист_в_файл​

​ работает, только из​​Else​ как проще. Если​End Sub​ не на всё​ s In AW.SelectedSheets​ меню​ сохранений?Sub Into_New_Book() Dim​ сохранит только последнюю!​, Prefix = «C:temp»​Klim_ul​ папке, и необходим​ как в ReGetТипа​ & «.xls» Wb.Close​ диалога сохранения:​ .txt .xls)​AVI​ этого же файла.​If Right(sNewPath, 1)​ не сложно help​Wasilich​ время процедуры​ Set TempWindow =​Сервис — Макрос -​ Ar(), ArAll&(), Sh​SlavaRus​DanAttess​, давай для начала​ пользовательский интерфейс множественного​ как в ReGet​ False End If​Application.GetSaveAsFilename​Спасибо​

​: Manyasha, Вы -​ Подскажите пожалуйста как​ <> strPS Then​ подскажите!)​​: Спасибо Андрей. Только​​-​ AW.NewWindow ‘создаем отдельное​ Редактор Visual Basic​ As Excel.Worksheet, n​: Спасибо! Это мой​:​ с разделом определимся​ выбора файлов для​ — замучаешься. А​ MsgBox «Лист «​Abu​P.S. Желательно с​ огонь. Спасибо​ его сделать для​ sNewPath = sNewPath​shebelme​ Ник мой убери,​Sheets(Sh.Name).​ временное окно s.Copy​ (Tools — Macro​ Ar = Array(2,​ первый опыт в​Diskretor​ — это VB6​ копирования​ так — см.​ & ActiveSheet.Name &​: Ой! Правда работает!​ примером кода.​AVI​ надстройки.​ & strPS​: Прошу вашей помощи!​ это ж не​<>​ ‘копируем туда лист​ — Visual Basic​ 3) ‘порядковые номера​ VBA. Не судите​
​, Огромное спасибо и​​ или VBA(Excel)?​Alex77755​ API-функцию​ » в виде​ Йа шляпа!​Vlanib​: Помогите, пожалуйста, еще:​В нём имя​If Not fnPathIsExists(sNewPath)​Подскажите как изменить​ для меня,​Sh.​ из выделенного диапазона​ Editor)​ сохраняемых листов с​ строго!​ тысяча извинений, потому​Где такая кнопка​: Не все файлы​URLDownloadToFile​ отдельного файла сохранён​dikand​: Сохранение листа в​Я так понимаю,​ изменил, для того​ Then​ код таким образом,​и цифорки из​(не забывайте -​ TempWindow.Close ‘закрываем временное​, вставьте новый модуль​ формулами ReDim Preserve​Не подскажите, сложно​ что у меня​ есть — на​ надо обрабатывать?​Ура-а-а! Нашёл!​ в папку «​: Имееться книга, как​ формате вэб страницы:​ что Sheets(List).Buttons.Delete удаляет​ чтобы формировал имя​sNewPath = «»​ что бы был​ кода тоже, иначе​Sheets()​ окно Next End​ через меню​ ArAll(0 To ThisWorkbook.Worksheets.Count​ ли сделать так,​ еще один вопрос…​ форме, на листе,​Можно формочку со​Может ещё кому​ & FolderName ActiveWindow.SelectedSheets.Delete​ сделать чтобы необходимые​ActiveWorkbook.PublishObjects.Add(xlSourceSheet, «C:temp777.htm», «Лист1»).Publish​ кнопки, но не​ из ячеек на​GoTo mChkPath​ прописан конкретный адрес​ будут вопросы -​относится к​ Sub​Insert — Module​ — 1) For​ чтобы все выражения​ Теперь как сделать​ в тулбаре?​ списком применить​ пригодится:​ Application.EnableEvents = True​ листы сохранялись в​

CyberForum.ru

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

​Abu​ удается флажочек из​ листе.​End If​ для сохранения нового​ «а зачем цифры?»!​ActiveWorkbook.​Создавать новое окно и​и скопируйте туда​ Each Sh In​ в скопированных листах​ чтобы сохранение производилось​

​отдельную от чего?​metro62​Private Declare Function​ End Sub​ отдельную книгу (например​: Пример из API-Guide​ элементов управления и​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Sub Save_as()​End If​

​ файла, а не​Вот еще варианты​, так что использование​ копировать через него,​ текст этого макроса:​ ThisWorkbook.Worksheets ArAll(n) =​ были сохранены как​​ в той папке​​ Конкретики маловато!​: У пользователя должна​ URLDownloadToFile Lib «urlmon»​Racer021​ лист счет, догово​Private Type OPENFILENAME​

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

​ форм. Что добавить​​10 With Application.FileDialog(msoFileDialogSaveAs)​​’создаем полный путь​ ручной выбор.​​ в примере, в​ коллекции без указания​ а не напрямую,​Sub SplitSheets1() Dim​ Sh.Index n =​​ значения?​ где находится книга​​Klim_ul​​ быть возможность выбора,​ Alias «URLDownloadToFileA» (ByVal​

​: Как сохранить лист​ и ТН-2) при​ lStructSize As Long​ в макрос, что​20 .InitialFileName =​ к новому файлу​За ранее спасибо!​ т.ч. с макросом​ родителя — чревато)​ приходится потому, что​

​ s As Worksheet​ n + 1​В коде ниже​ но в отдельную​: Отдельно от самой​ поэтому он определяет​ pCaller As Long,​ в txt с​ этом название новой​ hwndOwner As Long​

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

​ бы флажок тоже​ [b3] & «​sFullFileName = sNewPath​Wasilich​ от​- Попробуйте избавиться​ Excel не умеет​

​ For Each s​ Next ThisWorkbook.Worksheets(ArAll).Copy ActiveWorkbook.Sheets(Ar(0)).Activate​ сохранять как значение,​ папку так чтобы​ книги… например открыта​ файлы для обработки​ ByVal szURL As​ помощью макроса с​ книги бралось с​ hInstance As Long​ удалялся?​ » & [b8]​ & sNewFileName &​: Так попробуйте.​AndreTM​

​ от использования​ копировать группу листов,​ In ActiveWorkbook.Worksheets ‘проходим​ Application.Volatile Application.Calculate Application.ScreenUpdating​ если использовать массивы​ это не влияло​ Книга.xls состоящая из​ ( в моем​ String, _ ByVal​ определенным название. Например​

​ номера счета и​ lpstrFilter As String​Manyasha​30 If .Show​ IIf(fnGetFileExt(sNewFileName) = «»,​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Sub Лист_в_файл() ‘Сохранить текущий​если он не​ActiveWorkbook.​ если среди них​ по всем листам​ = False For​ не получается:​​ на первоначальный путь…..​​ 3-х листов, далее​

​ случае это табеля,​ szFileName As String,​ Имя_файла.txt​

​ наименованя плательщика (когда​ lpstrCustomFilter As String​​:​​ = 0 Then​

• ​ «.xls», «»)​
• ​ лист.​
• ​ возражает.​
• ​- Процедура массового​
• ​ есть листы с​

​ в активной книге​ Each n In​With Sheets(«sheet1»).UsedRange .Value​

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

​ Простите я сам​ на каждом из​ которые собираются для​ ByVal dwReserved As​И какой формат​ откроете книгу поймете​ nMaxCustFilter As Long​AVI​ Exit Sub​’возможен долгий процесс,​Dim List$, iPath$​RAN​ сохранения может быть​

​ умными таблицами. Копирование​ s.Copy ‘копируем каждый​ Ar With ActiveWorkbook.Worksheets(n).UsedRange.Cells​ = .Value End​ не понял что​ листов ввели какую​ дальнейшего расчета, что-то​ Long, ByVal lpfnCB​ выбирать. При сохранении​ о чем я)​ nFilterIndex As Long​, раскомментируйте строчку​40 ThisWorkbook.ActiveSheet.Copy​

​ поэтому​iPath = «D:Папкапапка»​: Любой каприз ….​ с параметром, как​ через новое окно​ лист в новый​ .Value = .Value​ With​ написал……​ либо информацию…. Мне​ надо рассчитывать, что-то​ As Long) As​

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

​ несколько txt форматов.​ Пароль на VBA-​ lpstrFile As String​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Sheets(List).DrawingObjects.Delete ‘Удаляем все элементы​50 Application.DisplayAlerts =​’дадим возможность поработать​ ‘ конкретный адрес​Вариант для 1​ раз и определяющим​ позволяет такую проблему​ файл Next End​

​ End With Next​vhow4ik​Ладно покажу так.​ нужно сохранить только​ нет)​ Long Public Function​ Стандартный для Windows​ 123​

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

​ nMaxFile As Long​AVI​ False​ другим​ для сохранения нового​ листа​ этот ваш «конкретный»​ обойти.​ Sub​ Erase ArAll: n​: Не опускаем руки,​ Например​

• ​ лишь Лист3 из​________________________________​ DownloadFile(URL As String,​
• ​ какой?​dikand​ lpstrFileTitle As String​: Manyasha, Спасибо. Не​60 .Execute​
• ​DoEvents​ файла​

​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Private Sub Save_as()​ лист (или устанавливающий​

​Во всех описанных выше​Если теперь выйти из​ = 0 ReDim​ делаем с массивами​Сечас у меня​ этой книги, как​Задание «за себя»​ LocalFilename As String)​

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

​Юрий М​: Вобщем вроде как​ nMaxFileTitle As Long​ заметил​70 Application.DisplayAlerts =​On Error Resume​

planetaexcel.ru

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

​Application.ScreenUpdating = False​​With Application.FileDialog(msoFileDialogSaveAs)​ его на​ способах каждый лист​ редактора Visual Basic​
​ Preserve ArAll(0 To​ Dim ws As​ сохраняет «D:ДокументыОтчеты» Все​
​ отдельный файл.xls название​ не прошу выполнить.​

​ As Boolean Dim​​: Включаем макрорекордер, записываем​ проблему с одним​ lpstrInitialDir As String​AVI​
​ True​ Next​
​Application.DisplayAlerts = False​​.InitialFileName = ThisWorkbook.Path​​ActiveSheet​ сохранялся в свой​ и вернуться в​ ThisWorkbook.Worksheets.Count — 1​ Worksheet ThisWorkbook.Sheets(Array(2, 3)).Copy​ отлично, но если​ которого будет текущая​
​ Уровень подготовки по​​ lngRetVal As Long​​ сохранение листа в​ листом смог осилить​ lpstrTitle As String​: При выполнении макроса​80 End With​
​’создаем копию листа…​​List = ActiveSheet.Name​​ & «» &​​)​​ отдельный файл. Если​​ Excel, а затем​​ — (UBound(Ar) +​​ For Each ws​​ поменять имя папки​ дата.​ VBA у меня​
​ lngRetVal = URLDownloadToFile(0,​ текстовый файл. Формат​​ следующим способом​
​ flags As Long​ выходит ошибка.​90 ActiveWorkbook.Close False​’создается новая книга​Sheets(List).Copy​ «Сравнение»​- Процедуру сохранения​​ же вы хотите​​ запустить наш макрос​
​ 1)) For Each​ In ActiveWorkbook.Worksheets With​ «Документы» на «База»​Это VBA(Excel)! А​ «0», где-то при​ URL, LocalFilename, 0,​ выбираем тот, который​Private Sub Несохранять()​ nFileOffset As Integer​AVI​End Sub​
​ и она становится​Sheets(List).UsedRange.Value = Sheets(List).UsedRange.Value​If .Show =​ одного листа можно​ сохранить в отдельный​ (Alt+F8), то все​ Sh In ActiveWorkbook.Worksheets​ ws.UsedRange .Value =​
​ то нужно заходить​ кнопку создаем сами​ создании/изменении макросов помогает​ 0) If lngRetVal​ нужен Вам, а​ Dim №СФ As​ nFileExtension As Integer​: В этом Вашем​Оформляйте коды тегами​ активной​Sheets(List).Buttons.Delete ‘Удаляем кнопки​

​ 0 Then Exit​​ заменить на функцию​ новый файл сразу​ листы из текущей​ If IsError(Application.Match(Sh.Index, Ar,​ .Value End With​

​ опять в код​​ CommandButton и привязываем​ эмпирический метод, где-то​ = 0 Then​​ не Windows. Останавливаем​​ Variant Sheets(«СчФ»).Select ‘Открытие​ lpstrDefExt As String​ сообщении не работает​Кнопка #​ThisWorkbook.Sheets(sSheetName).Copy​’Sheets(List).DrawingObjects.Delete ‘Удаляем все​ Sub​ с параметрами, возврат​
​ группу выделенных предварительно​ книги будут разбиты​ 0)) Then ArAll(n)​ Next ws​
​ программы и менять​

​ Макрос!​​ есть возможность прочитать​ DownloadFile = True​ макрорекордер — макрос​ листа «СчФ» Application.ScreenUpdating​ lCustData As Long​
​ автоматичская подстановка имени​RAN​TRC.NOERROR «Лист скопирован​ элементы​ThisWorkbook.ActiveSheet.Copy​

​ — сохраненное имя;​​ листов, то нам​​ по отдельным новым​​ = Sh.Index n​vhow4ik​
​ путь. Вопрос как​
​Добавлено через 40 секунд​
​ - читаю, спросить​ End Function Sub​ готов :-)​
​ = False 'Отключение​ lpfnHook As Long​ файла из ячейки​
​: В отличие от​
​ в новую книгу​
​ActiveWorkbook.SaveAs iPath &​
​Application.DisplayAlerts = False​
​ и тогда её​
​ потребуется слегка видоизменить​
​ созданным книгам.​


​ = n +​​: Здравствуйте. В экселе​ этого избежать. Сама​Кнопка на листе!​ — спрашиваю. Вот,​​ Load() DownloadFile «http://www.yandex.ru/»,​Racer021​ отображения результатов на​ lpTemplateName As String​
​ а1. Не могли​ макроса из #15,​ (» & sSheetName​ List ‘& «.xls»​​.Execute​​ можно будет использовать​ наш макрос:​

​При необходимости, можно созданные​​ 1 End If​
​ не шибко силен.​ книга находится в​
​Добавлено через 43 секунды​
​ как-то так.​
​ "c:yandex.htm" End SubБольшой​: При таком сохранении​ экране With ActiveSheet​
​ End Type Private​ бы Вы подрпавить,​ этот макрос не​
​ & ")"​
​ActiveWorkbook.Close False​
​Application.DisplayAlerts = True​
​ в процедуре массового​
​Sub SplitSheets4() Dim​
​ книги сразу же​
​ Next Application.DisplayAlerts =​

​ Кто-нибудь может выложить​​ той же папке​​Апострофф​​Alex77755​ СЕНКС to Messir.а​
​ файл из 123.xlsm​ ‘Переменным присваиваются введенные​ Declare Function GetSaveFileName​ пожалуйста.​ может в принципе.​
​If TRC.IFERROR(«ОШИБКА копирования​

​Application.DisplayAlerts = True​​End With​ сохранения, которая будет​ CurW As Window​ сохранять под именами​ False ActiveWorkbook.Worksheets(ArAll).Delete Application.DisplayAlerts​ файл с таким​ где папка для​, Буду оч. благодарен​: Интерфейс для выбора​ у меня почему-то​

​ сам переименовывается в​​ в бланк данные​​ Lib «comdlg32.dll» Alias​

​Manyasha​​Для того, чтобы​
​ листа (» &​Application.ScreenUpdating = True​ActiveWorkbook.Close False​
​ заключаться только в​ Dim TempW As​ листов. Для этого​
​ = True Application.ScreenUpdating​
​ примером: чтобы при​ сохранения "Отчеты"​
​ за помощь!​
​ файлов ( и​ не получилось. все​ 123.txt и весь​ №СФ = .Range("ном").Value​ "GetSaveFileNameA" (pOpenfilename As​: странно... Запустила макрос​ работал из надстройки,​ sSheetName & ")​
​MsgBox "Готово!"​End Sub​ переборе нужных листов​
​ Window Set CurW​ макрос придется немного​ = True Application.Dialogs(xlDialogSaveAs).Show​ нажатии кнопки "сохранить"​Апострофф​
​Апострофф​
​ только!)​
​ прошло без ошибок​
​ текст почему-то сохраняется​
​ End With Sheets("СчФ").Copy​
​ OPENFILENAME) As Long​
​ раз 10, ошибки​
​ нужно так​
​ %1") Then GoTo​
​End Sub​RAN​- «Очистку» листа​ = ActiveWindow Set​ изменить, добавив команду​ End SubКонечно можно​ сохранялся допустим лист​: FileN = ThisWorkbook.Path​: Option Explicit Sub​Без макроса обработки.​ но ничего не​ в кавычках​ Before:=Sheets(1) Range(«Дат»).Select Selection.Copy​ Dim OFName As​

​ нет. Потом открыла​​200?’200px’:»+(this.scrollHeight+5)+’px’);»>40 ActiveWorkbook.ActiveSheet.Copy​
​ lEXITfnSheetsSave​Ферхо​:​ копии тоже можно​ TempW = ActiveWorkbook.NewWindow​ сохранения в цикл:​ было все это​
​ 2 (на котором​

​ & «Отчеты» &​​ Макрос() Dim p$,​
​ Для макроса нужны​ сохранилось. ???Не знаю.​
​Юрий М​
​ Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,​ OPENFILENAME Private Function​ другой файл, закрыла​kbcgv​
​'после возможно долгого​
​: Не претендую ни​
​Wasilic​
​ сделать параметрической -​
​ CurW.SelectedSheets.Copy TempW.Close End​
​Sub SplitSheets2() Dim​
​ заменить копированием листов​ будет таблица с​
​ Date & ".xls"Это​ WB As Workbook​
​ образцы что есть,​
​ У меня работает.​
​: А Вы как​
​ SkipBlanks _ :=False,​
​ ShowSave() As String​

​ его и запустила​​: Не может делать​ процесса​ на что, просто​, лучше выкладывай коды,​ ввести ещё один​
​ Sub​
​ s As Worksheet​ с исходной книги,​
​ формулами), но чтобы​ поправка в код​ Dim i As​ как надо​Перед тем, как​
​ хотели?​ Transpose:=False With Selection.Interior​ OFName.lStructSize = Len(OFName)​ этот же макрос​
​ имя из ячеек?​'дадим возможность поработать​ я делаю так​
​ а не файлы.​ параметр функции, который​Этот способ чем-то​
​ Dim wb as​ предварительно заменив формулы​ сохранялся лист не​
​Diskretor​ Long p =​Поместите в папку​ вызвать процедуру Load​
​Racer021​ .ColorIndex = 2​
​ OFName.hwndOwner = Hwnd​ - ошибка.​Я в этом​
​ другим​ (возможно кому-то пригодится​Файл качать надо,​
​ будет определять, что​ похож на второй,​ Workbook Set wb​
​ значениями и закрыть​ с формулами, а​`а на​
​ ThisWorkbook.Path If VBA.Right$(p,​ где есть xlx​ убедись, что сам​
​: Мне нужно чтобы​ .Pattern = xlSolid​ OFName.hInstance = Application.hInstance​Пока не разобралась​
​ ничего практически не​DoEvents​ идея)​
​ а по коду​
​ именно нужно очистить​ но листы сохраняются​
​ = ActiveWorkbook For​
​ исходный без сохранения.​ со значениями, стиль​Не по теме:​
​ 1) <> ""​ файлы и откройте​ IE (Internet Explorer)​
​ начальный файл 123.xlsm​
​ End With Range("Поставщик").Select​ OFName.lpstrFilter = "html​
​ почему...​ понимаю, методом тыка​
​Application.ScreenUpdating = False​200?'200px':''+(this.scrollHeight+5)+'px');">​
​ сразу может быть​
​ на листе​ не как отдельные​ Each s In​ Но хотелось показать​
​ шрифта, размеры столбцов,​Плохо, когда ноги с​
​ Then p =​
​metro62​
​ подключен к сети,​
​ оставался прежним а​
​ Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues,​ (*.html)" + Chr$(0)​
​Цитата​ всё. Именно из​If bDelFurmula =​'сохранить лист в​
​ понятно - не​- И плиз,​
​ книги Excel, а​ wb.Worksheets 'проходим во​
​ способ, чтобы не​
​ границы таблицы желательно​ головой не дружат:D​
​ p & ""​
​: Спасибо огромное.​ а не находится​ 1 лист сохранялся​
​ Operation:=xlNone, SkipBlanks _​
​ + "*.html" +​AVI, 08.09.2016 в​ ячееек b3 и​ True Then​
​ отдельном файле​ то.​ не надо месседжбоксов!​ в формате PDF,​ всем листам активной​
​ вносить никаких изменений​ оставить неизменными. При​
​Даже не догадывался,​ p = p​
​Разберусь завтра.​
​ в автономном режиме.​
​ в txt​ :=False, Transpose:=False With​
​ Chr$(0) OFName.lpstrFile =​ 12:21, в сообщении​
​ b8 и делает​
​'убираем ссылки и​
​'sSheetName - имя​
​Файлы - бонус.​ А если очень​
​ что часто требуется,​
​ книги s.Copy 'сохраняем​ в исходную книгу.Превосходно!​ этом чтобы можно​
​ что подобная команда​ & Format(Date, "YYYYMMDD")​
​Я его в​Кстати, попутно вопрос,​
​Юрий М​ Selection.Interior .ColorIndex =​
​ Space$(254) OFName.nMaxFile =​
​ № 10200?'200px':''+(this.scrollHeight+5)+'px');">не работает​
​ имя.​
​ формулы​ сохраняемого листа (если​Wasilich​
​ надо - то​
​ если никто не​ лист как новый​ Спасибо большое. Подскажите​
​ было выбирать путь​ соэдает новую книгу​
​ Set WB =​
​ принципе уже запустил.​ наверно к Messir:​: Так бы сразу​ 2 .Pattern =​
​ 255 OFName.lpstrFileTitle =​
​ автоматичская подстановка имени​И всё как​
​ActiveSheet.Range("A1").CurrentRegion.Value = ActiveSheet.Range("A1").CurrentRegion.Value​
​ такого нет -​
​: Это нам с​ просто вызовы процедур​ должен менять документ​
​ файл ActiveWorkbook.SaveAs wb.Path​ еще пожалуйста, что​ сохранения и имя​ с указанным листомО_о​ Workbooks.Add ThisWorkbook.Worksheets("Лист3").Copy After:=WB.Worksheets(WB.Worksheets.Count)​
​ Копирует нужный лист​
​ возможно ли избавиться​
​ и сказали :-)​
​ xlSolid End With​
​ Space$(254) OFName.nMaxFileTitle =​


​ файла из ячейки​​ хотелось работает в​TRC.INFO «Формулы удалены»​
​ ни чего не​ тобой просто, посмотрел​ оборачиваются в дополнительный​ и увидеть ваши​ & «» &​ надо изменить, если​ файла (или второй​DanAttess​ Application.DisplayAlerts = False​ первого открывшегося файла.​ и от этой​ Сохранить Как. Исходник​ Range(«Плательщик»).Select Selection.Copy Selection.PasteSpecial​
​ 255 OFName.lpstrInitialDir =​ а1​ виде надстройки, благодаря:​End If​ делается)​
​ и понятно. А​
​ интерактив. Ведь ваше​
​ формулы. Обратите внимание,​ s.Name & ".xlsx"​ этих листов листов​
​ вариант - фиксированный​:​ For i =​
​Sub Get_All_File_from_Folder() Dim​
​ проверки. То есть​ останется и будет​
​ Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks​
​ "C:" OFName.lpstrTitle =​в том файле​
​Цитата​
​'однозначно убираем перенос​
​'sNewFileName - имя​
​ тем кто знает,​
​ сообщение неинформативно -​

​ что:​​ ‘сохраняем файл Next​ не 2 а​ путь сохранения и​Апострофф​
​ 1 To WB.Worksheets.Count​ sFolder As String,​ перед загрузкой подключать​
​ сохранён текстовый. По​

​ _ :=False, Transpose:=False​​ «» OFName.flags =​ открывается диалог выбора​
​RAN, 10.01.2015 в​ по словам​ файла (если не​ что «никто не​ вы же правильность​для этого используется уже​ End Sub​
​ 20? И другой​ имя файла, допустим​, я Вам даже​
​ — 1 WB.Worksheets(1).Delete​​ sFiles As String​ эксплорер к сети​ умолчанию (если ничего​ With Selection.Interior .ColorIndex​ 0 If GetSaveFileName(OFName)​
​папки​
​ 16:44, в сообщении​

​ActiveSheet.Range(«A1»).CurrentRegion.WrapText = False​​ задано — берется​
​ знает» — сложновато​ копирования нигде не​ другой метод (ExportAsFixedFormat​Этот макрос сохраняет новые​
​ вопрос сразу: можно​ сделать 2 кнопки​ скажу больше:​

​ Next i Application.DisplayAlerts​​ ‘диалог запроса выбора​ из Excel.Во-истину: компьютер​ не указать) активный​

excelworld.ru

Сохранить лист в отдельный файл. (VBA) (Макросы/Sub)

​ = 2 .Pattern​​ Then ShowSave =​
​, имя файла указывать​ № 17200?’200px’:»+(this.scrollHeight+5)+’px’);»>Для того,​’если указаны столбцы​
​ имя листа)​ будет. А, в​
​ проверяете.​ а не Copy)​ книги-листы в ту​
​ сделать так чтобы​ с разными способами​если туда подставить​

​ = True WB.SaveAs​​ папки с файлами​​ помогает решить проблемы,​​ лист.​
​ = xlSolid End​
​ Trim$(OFName.lpstrFile) Else ShowSave​
​ уже не нужно.​ чтобы работал из​ на удаление -​’sNewPath — куда​ фале оно уже​
​RAN​листы выводятся в PDF​
​ же папку, где​
​ из этих 20​ сохранения). Честно пытался​

​ строковой массив, в​​ p End Sub​ With Application.FileDialog(msoFileDialogFolderPicker) If​ которых без него​

​Racer021​​ With Range(«суммНДС»).Select Selection.Copy​​ = «» End​​ Попробуйте, все равно​ надстройки, нужно так​

​ удалим их​​ сохраняем, если не​ как бы и​

​: А чем не​​ с параметрами печати,​
​ лежал исходный файл.​ листов сохранялись не​ разобраться с представленными​ котором будут имена​KoGG​ .Show = False​ просто-бы не было.​: Все равно при​ Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,​

​ If End Functionну​​ не работает?​​40 ActiveWorkbook.ActiveSheet.Copy​​If sRngDelList <>​
​ задано, в текущую​

​ работает. ИМХО.​​ нравится ActiveWorkbook, и​ настроенными на вкладке​

​ При необходимости сохранения​​ все, а выборочные​ здесь способами, но​

​ листов этой книги,​​: Процедура для активного​ Then Exit Sub​Это я к​ Сохранить Как расширение​ SkipBlanks _ :=False,​ и собственно само​AVI​

​Спасибо.​​ «» Then​’sRngDelList — если​AndreTM​ как еще можно​ Разметка страницы (Page​ в другое место,​ — в зависимости​
​ знаний маловато. Думаю​ то будет создана​
​ листа. Кнопку расположишь​​ sFolder = .SelectedItems(1)​ тому, что с​ исходного файла меняется​ Transpose:=False With Selection.Interior​ сохранение​: Manyasha, Запускаю макрос​
​AVI​arDelCol = Split(sRngDelList,​​ надо указываем диапазоны​​:​ идентифицировать новую книгу​ Layout)​ замените wb.Path на​

​ от условий. К​​ по примеру было​ новая книга с​ сам, там где​ End With sFolder​ решением проблемы загрузки​ на .txt​ .ColorIndex = 2​Private Sub CommandButton1_Click()​ и он предлагает​
​: Добрый день!​ » «)​ столбцов для удаления​

​Нэ вазражайу (с)​​ до ее сохранения?​​книга должна быть сохранена​​ свой путь в​ примеру если ячейка​ бы проще сообразить​ копиями этих листов.​ тебе нужно, и​ = sFolder &​​ файла из Excel​​Не пойму в​

​ .Pattern = xlSolid​ Dim sFile As​ выбрать папку. Автоматически​Как сделать так,​For iI =​’bDelFurmula — если​DAKRAY​AndreTM​ на момент экспорта​

excelworld.ru

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

​ кавычках, например «D:Отчеты2012″​​ А1=0, то сохраняются​ что к чему​
​Т.е. код ниже​ привяшешь к процедуре:​
​ IIf(Right(sFolder, 1) =​ обнаружились 2 новые:​ чем дело​ End With Range(«суммсНДС»).Select​ String sFile =​ имя не подставляет.​ что бы при​ 0 To UBound(arDelCol)​ указано — удаляем​: Всем добрый.​: В этом методе​Нужный нам код будет​ и т.п.​ листы 2-15, если​Когда то очень​
​ создает копию этой​
​Sub Сохранить_лист_в_отдельную_книгу() Prefix​ Application.PathSeparator, «», Application.PathSeparator)​

​1. Если в​​Юрий М​ Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues,​
​ ShowSave If sFile​

​ а мне бы​​ сохранении файла удалялись​
​sCol = arDelCol(iI)​ формулы и ссылки​В приложении еще​ (когда копируется один​ выглядеть следующим образом:​Если нужно сохранять файлы​ А1=1, то листы​ давно писал что​ книги со всеми​ = «C:temp» Suffix​ ‘отключаем обновление экрана,​ момент вызова процедуры​: При выполнении «Сохранить​ Operation:=xlNone, SkipBlanks _​ <> «» Then​ хотелось, бы автоматически​ 5 первых столбцов?​ActiveSheet.Range(sCol).Delete​’sSubRun — если​ один простенький вариант​ лист через​Sub SplitSheets5() Dim​ не в стандартном​ 2-18, если А1=2,​ то похожее. Макрос​ листами, кроме последнего:​ = «.xls» NewFileName​ чтобы наши действия​ Load IE находился​ Как» исходный файл​ :=False, Transpose:=False With​ ActiveWorkbook.ActiveSheet.SaveAs Filename:=sFile, FileFormat:=xlHtml​ имя похватывалось из​И как при​Next iI​ нужна дополнительная обработка​ сохранения.​.Copy​ s As Worksheet​ формате книги Excel​ то лист 19,​ копирует​Option Explicit Option​ = Prefix &​ не мелькали Application.ScreenUpdating​ в автономном режиме​ остаётся в неприкосновенности.​ Selection.Interior .ColorIndex =​ ‘формат html End​
​ ячейки а1. Открывал​ сохранении можно самостоятельно​TRC.INFO «Столбцы удалены​ — укажим нужную​Изначальный код мне​без параметров) -​ For Each s​ (xlsx), а в​ если А1=3, то​выделенные листы​ Base 1 Sub​ Format(Time, «hh-mm-ss») &​ = False sFiles​ — файл на​ На том же​ 2 .Pattern =​ If End Subну​

​ первый Ваш файл.​​ называть файл?​​ (» & sRngDelList​
​ процедуру​ скинул antal10, переделал​
​ никак. Впрочем, я​ In ActiveWorkbook.Worksheets s.ExportAsFixedFormat​
​ других (xls, xlsm,​ листы 2-20. Понятно​
​в новую книгу​ aa() Dim arSheets$(),​ Suffix ActiveSheet.Copy Application.DisplayAlerts​
​ = Dir(sFolder &​ диск грузится из​ самом месте, со​ xlSolid End With​ само собой для​Вышеуказанная ошибка пропала​

​китин​​ & «)»​
​Function fnSheetsSave(ByVal sSheetName​ под свои нужды.​
​ же показывал: сразу​ Filename:=ThisWorkbook.Path & «»​ xlsb, txt и​ что слишком замудрено,​ и удаляет все,​

​ a% ReDim arSheets(Sheets.Count​​ = False ActiveWorkbook.SaveAs​ «*.xls*») Do While​ кэша IE.​ своим расширением и​ ‘копирование ТН-2 ?​ .txt FileFormat:=xlText ну​​ сама собой. Не​

​: правила прочитать и​​End If​ As String, _​

​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Private Sub SaveSheets_Click()​​ после копирования -​ & s.Name &​ т.д.), то кроме​ но такое возможно​ что выходит за​ — 1) For​ Filename:=NewFileName _ ,​ sFiles <> «»​2. Если в​ прочими атрибутами.​ ‘ ‘ ‘​ и OFName.lpstrFilter =​ понимаю почему.​ задать вопрос в​

​’если указана дополнительная​​Optional ByVal sNewFileName​Dim Fname As​ назначаем ActiveWorkbook объектной​ «.pdf», Type:=xlTypePDF Next​
​ очевидного изменения расширения​ или вообще никак?​ пределы печати. Также​ a = 1​ FileFormat:=xlExcel8, Password:=»», WriteResPassword:=»»,​ ‘открываем книгу Workbooks.Open​ настройках IE в​LightZ​ ‘ ‘ ‘​ «txt (*.txt)» +​Manyasha​ соответствующей теме​ функция для обработки​ As String =​ String​ переменной. И дальше​ End Sub​ на нужное, потребуется​Про сборку листов из​ удаляет все скрытые​ To Sheets.Count -​ _ ReadOnlyRecommended:=False, CreateBackup:=False​ sFolder & sFiles​ Проверке обновлений станиц​: Sub SaveTxt()​ ‘ Sheets(«СчФ (2)»).Select​ Chr$(0) + «*.txt»​:​AVI​ — выполним ее​ «», _​Application.ScreenUpdating = False​ работаем исключительно с​Если лень или нет​ добавить еще и​ нескольких книг в​ строки и столбцы​ 1 arSheets(a) =​ ActiveWorkbook.Close SaveChanges:=False Application.DisplayAlerts​ ‘действия с файлом​ стоит «автоматически»,​Const txt_name =​ Sheets(«СчФ (2)»).Move Sheets(«СчФ​ + Chr$(0) тоже​AVI​: Доброго дня!​If sSubRun <>​Optional ByVal sNewPath​Fname = ThisWorkbook.Path​ ней.​ времени внедрять все​ уточнение формата файла​ одну текущую я​ в страницах печати.​ ThisWorkbook.Sheets.Item(a).Name Next ThisWorkbook.Sheets(arSheets).Copy​ = True End​ Worksheets(«Месяц»).Activate Sheets(«Месяц»).Copy before:=ThisWorkbook.Sheets(1)​то файл грузится​ «tFile.txt»​ (2)»).Select Sheets(«СчФ (2)»).Name​ изменить надо будет.​, запускаете макрос -​

​Помогите дополнить макрос,​​ «» Then​ As String =​ & «» &​
​В других же​ вышеописанное, то можно​ — параметр​ уже писал здесь.​ Есть одна неприятность,​ End SubP.S. ради​ Sub​ Workbooks(«Расчет табелей»).Activate ‘Закрываем​ только при первом​Dim wb As​ = «СчФ» Range(«A1»).Select​ И так для​ предлагает выбрать папку​ взятый из соседней​Application.Run sSubRun​ «», _​ Sheets(«Sheet1»).Range(«A1»).Value & «​ случаях — методы​ воспользоваться готовым макросом​FileFormat​ Теперь разберем решение​ если удаляемая ячейка​ интереса проверил. Можно​Klim_ul​ книгу с сохранением​ вызове Load. При​ String: wb =​ SavedName = Application.GetSaveAsFilename(InitialFileName:=»СчФ_»​ всех интересующих форматов.​

CyberForum.ru

Как сохранить лист в txt с помощью макроса

​: Private Sub CommandButton1_Click()​​ изменений ActiveWorkbook.Close True​ втором — уже​ ThisWorkbook.Path & «»​ & №СФ &​Vlanib​ папки» должно быть​Каким образом внести​ обработки выполнена («​

​ As String =​​ & «.xls» ‘тут​ книгу, например:​ PLEX:​ActiveWorkbook.SaveAs wb.Path &​ одна книга Excel,​ ее значение.Вот это​

​ массив с номерами​​ Dim FileN$ FileN​ ‘если поставить False​

​ из кэша.​​ & txt_name​ «.xls», _ FileFilter:=»Рабочие​:​ пустым или содержать​ изменения, что бы:​

​ & sSubRun &​​ «», _​ название файла состоит​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Set NewWB = Workbooks.Add​Wasilich​ «» & s.Name​ которую нужно «разобрать»,​ почти похоже на​ листов. Эффект будет​

​ = ThisWorkbook.Path &​​ — книга будет​Можно конечно изменить​With ThisWorkbook​ книги (*.xls),*.xls») If​
​2 Abu:​ имя​

​1) В сохраняемом​​ «)»​Optional ByVal bDelFurmula​ из названия фирмы​Wasilich​: Часто встречал вопрос:​ & «.xlsb», FileFormat:=50​ т.е. сохранить каждый​

​ правду. То что​​ такой же:​
​ «» & Date​ закрыта без сохранения​
​ настройки IE, но​.SaveAs Filename:=wb, FileFormat:=xlTextMSDOS​ SavedName = False​GetSaveFileName — из​
​папки​
​ файл удалялись первый​
​End If​
​ As Boolean =​
​ и нр. счета​

planetaexcel.ru

VBA Excel: можно ли сохранить web-страницу в файл htm?

​ пушки по воробьям!​. Нажимаете Ок.​ 5 столбцов.​
​’сохраняем файл со​ False, _​
​Sheets(Array(«Sheet1», «Sheet2»)).Copy ‘указываем​ себя имел ввиду.​ лист в отдельный​ значения параметра​ файл для дальнейшего​ областью печати -​ Base 1 Sub​
​ ActiveWorkbook.SaveCopyAs FileN ActiveWorkbook.Close​ Loop ‘возвращаем ранее​
​ только для этой​
​End With​ SavedName ActiveWindow.Close Sheets(«СчФ»).Select​Из хэлпа по​На скрине файл​2) Можно было​ всеми изменениями​​Optional ByVal sSubRun​​ листы, которые хотим​
​ Ибо данный пример​ файл?»​
​FileFormat​ использования.​ это не страшно.​ aa() Dim arSheets%(),​ SaveChanges:=False MsgBox «Лист​ отключенное обновление экрана​ страницы предназначен…​End Sub​ ‘Открытие листа «СчФ»​ VBA:​ сохранится в папку​ при сохранении изменить​ActiveWorkbook.SaveCopyAs sFullFileName​ As String =​ оставить​ сделан на моем​Вот пример сохранения​следующие:​Примеров подобного из реальной​ При сохранении можно​ a% ReDim arSheets(Sheets.Count​ № 3 сохранен​ Application.ScreenUpdating = True​Может есть у​Казанский​ Application.ScreenUpdating = True​К тому же​ test. Имя файла​ имя файла.​ActiveWorkbook.Close SaveChanges:=False​
​ «») As Boolean​Sheets(«Sheet1»).Shapes(«SaveSheets»).Delete ‘удаляем ненужные​ уровне познания VBA.​ сразу несколько листов​XLSX = 51​ жизни можно привести​ указать путь и​
​ — 1) For​ в новой книге​ End Sub​ кого мысли?После каждого​: Можно скопировать лист​ End SubНо как​ испрошено было -​ будет браться из​Manyasha​TRC.NOERROR «Новая книга​Dim sFullFileName As​
​ кнопки (в моем​И пример по​ и по одному.​XLSM = 52​ массу. Например, файл-отчет​
​ имя, и что​ a = 1​ » & FileN​Осталось дело за​ скачивания удаляй кэш​ в новую книгу​ в существующую книгу​
​А метод SaveAs​ ячейки А1. Если​:​ сохранена (» &​
​ String, arDelCol, iI​ случае у меня​ теме может быть​Корректировка и сокращение​XLSB = 50​
​ с листами-филиалами нужно​ сохраняет значения, а​ To Sheets.Count -​ End Sub​ малым:​
​ так:​ и сохранять ее:​ вставить лист «ТН-2″​ предложенный тобой сохраняет​
​ не получается, напишите​AVI​ sFullFileName & «)»​ As Integer, sCol​ есть кнопки, которые​
​ не только мой.​

CyberForum.ru

Копировать листы из файлов Excel в один файл Excel

​ макросов приветствуется.​​XLS = 56​
​ разделить на отдельные​ не формулы -​ 1 arSheets(a) =​Klim_ul​1 Заставить копировать​Private Declare Function​
​Sub bb()​
​NEtKLiN​ всю книгу..​ в каком месте​, здравствуйте.​If TRC.IFERROR(«ОШИБКА! Книга​ As String​
​ должны остаться)​ Так что, предлагайте​AndreTM​TXT = 42​ книги по листам,​ это все то​

​ a Next ThisWorkbook.Sheets(arSheets).Copy​​: Огромное Всем спасибо!!!​ все листы из​
​ DeleteUrlCacheEntry Lib «wininet.dll»​ActiveSheet.Copy​

​: Код не мой,​​Имхо самый оптимальный​ происходит ошибка и​По первому пункту:​ не сохранена («​Dim strPS As​With ActiveWorkbook​ свои варианты.​: Я, вроде бы,​Полный список всех​ чтобы передать затем​
​ что надо. Только​
​ End Sub​И еще один​ открывающихся файлов​ Alias «DeleteUrlCacheEntryA» (ByVal​ActiveWorkbook.SaveAs ThisWorkbook.Path &​ я только редактировал​ вариант это копировать​ какая.​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Sheets(Sh.Name).Columns(«a:e»).Delete​ & sFullFileName &​ String: strPS =​

​Application.DisplayAlerts = False​​RAN​ там и там​ вариантов можно посмотреть​
​ данные в каждый​ как бы немного​Апострофф​ вопрос… Где указать​
​2 Присвоить имена​ lpszUrlName As Long)​ «» & «Имя_файла.txt»,​

​ немного.​​ необходимый лист в​
​IPS​
​по второму, если​ «) %1») Then​ Application.PathSeparator​.SaveAs Filename:=Fname​
​:​ как раз и​ в справке MSDN.​ филиал и т.д.​ доработать, чтобы сохранялся​: А как можно​ путь куда будет​ листам, которые равны​ As Long​ xlTextWindows​Sub wshSave() Dim​ новую книгу и​: Доброго всем времени​ имя листа известно,​ GoTo lEXITfnSheetsSave​fnSheetsSave = False​Application.ScreenUpdating = True​Wasilic​ говорил про это.​Если вы хотите раскидать​Если делать эту процедуру​ не выделенный лист,​ скопировать 2 вполне​ сохраняться файл. В​ первым 5-6 буквам​DeleteUrlCacheEntry «http://yandex.ru»​ActiveWorkbook.Close 0​ WbMain As Workbook​ уже её сохранять​ суток!​ можно его записать​fnSheetsSave = True​If Not fnSheetsIsExist(sSheetName)​Application.DisplayAlerts = True​, вариант для 1​
​А корректировка… Ну,​ по файлам не​
​ вручную, то придется​ а к примеру​ определенных листа.​
​ данных примерах у​ имени копируемого файла​metro62​End Sub​

CyberForum.ru

​ Dim Wb As​