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

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

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

save-sheets-as-files.png

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

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

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

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

Sub SplitSheets1()
    Dim s As Worksheet
    For Each s In ActiveWorkbook.Worksheets    'проходим по всем листам в активной книге
        s.Copy       'копируем каждый лист в новый файл
    Next
End Sub

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

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

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

Sub SplitSheets2()
    Dim s As Worksheet
    Dim wb as Workbook
    Set wb = ActiveWorkbook
    For Each s In wb.Worksheets                                 'проходим во всем листам активной книги
        s.Copy                                                  'сохраняем лист как новый файл
        ActiveWorkbook.SaveAs wb.Path & "" & s.Name & ".xlsx"  'сохраняем файл
    Next
End Sub

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

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

ActiveWorkbook.SaveAs wb.Path & "" & s.Name & ".xlsb", FileFormat:=50  

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

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

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

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

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

Sub SplitSheets3()
    Dim AW As Window
    Set AW = ActiveWindow
    For Each s In AW.SelectedSheets
        Set TempWindow = AW.NewWindow    'создаем отдельное временное окно
        s.Copy                           'копируем туда лист из выделенного диапазона
        TempWindow.Close                 'закрываем временное окно
    Next
End Sub

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

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

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

Sub SplitSheets4()
    Dim CurW As Window
    Dim TempW As Window
    Set CurW = ActiveWindow
    Set TempW = ActiveWorkbook.NewWindow
    CurW.SelectedSheets.Copy
    TempW.Close
End Sub

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

Этот способ чем-то похож на второй, но листы сохраняются не как отдельные книги Excel, а в формате PDF, что часто требуется, если никто не должен менять документ и увидеть ваши формулы. Обратите внимание, что:

  • для этого используется уже другой метод (ExportAsFixedFormat а не Copy)
  • листы выводятся в PDF с параметрами печати, настроенными на вкладке Разметка страницы (Page Layout)
  • книга должна быть сохранена на момент экспорта

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

Sub SplitSheets5()
    Dim s As Worksheet

    For Each s In ActiveWorkbook.Worksheets
        s.ExportAsFixedFormat Filename:=ThisWorkbook.Path & "" & s.Name & ".pdf", Type:=xlTypePDF
    Next
End Sub

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

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

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

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

  • Создание файлов
  • Листы Excel
  • Книги Excel

Данный макрос позволяет упростить процедуру сохранения активного листа в книге 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 что-то там перемудрил)

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

Не получается применить макрос? Не удаётся изменить код под свои нужды?

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

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

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 листа

Спасибо Андрей. Только Ник мой убери, это ж не для меня, :) и цифорки из кода тоже, иначе будут вопросы — «а зачем цифры?»! :D

Вот еще варианты в примере, в т.ч. с макросом от 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

 

Ответить

0 / 0 / 0

Регистрация: 23.01.2012

Сообщений: 6

1

23.01.2012, 17:07. Показов 77907. Ответов 82


Студворк — интернет-сервис помощи студентам

Процедура по нажатию кнопки-сохранить к примеру лист3 из текущей книги как отдельный файл.xls с названием текущей даты в отдельную папку. А также если файл с таким названием уже существует, тогда перезаписать! Подскажите пожалуйста! Заранее спасибо!



0



Апострофф

Заблокирован

23.01.2012, 21:55

2

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

Цитата
Сообщение от Klim_ul
Посмотреть сообщение

по нажатию кнопки-сохранить

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

Цитата
Сообщение от Klim_ul
Посмотреть сообщение

как отдельный файл.xls с названием текущей даты в отдельную папку.

отдельную от чего? Конкретики маловато!



0



0 / 0 / 0

Регистрация: 23.01.2012

Сообщений: 6

24.01.2012, 10:10

 [ТС]

3

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

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

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

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



0



Апострофф

Заблокирован

24.01.2012, 11:23

4

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Option Explicit
 
Sub Макрос()
Dim p$, WB As Workbook
Dim i As Long
p = ThisWorkbook.Path
If VBA.Right$(p, 1) <> "" Then p = p & ""
p = p & Format(Date, "YYYYMMDD")
Set WB = Workbooks.Add
ThisWorkbook.Worksheets("Лист3").Copy After:=WB.Worksheets(WB.Worksheets.Count)
Application.DisplayAlerts = False
For i = 1 To WB.Worksheets.Count - 1
  WB.Worksheets(1).Delete
Next i
Application.DisplayAlerts = True
WB.SaveAs p
End Sub



3



KoGG

5590 / 1580 / 406

Регистрация: 23.12.2010

Сообщений: 2,366

Записей в блоге: 1

24.01.2012, 11:44

5

Процедура для активного листа. Кнопку расположишь сам, там где тебе нужно, и привяшешь к процедуре:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
Sub Сохранить_лист_в_отдельную_книгу()
    Prefix = "C:temp"
    Suffix = ".xls"
    NewFileName = Prefix & Format(Time, "hh-mm-ss") & Suffix
    ActiveSheet.Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=NewFileName _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWorkbook.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub



3



Dragokas

Эксперт WindowsАвтор FAQ

17993 / 7619 / 890

Регистрация: 25.12.2011

Сообщений: 11,352

Записей в блоге: 17

24.01.2012, 11:45

6

Лучший ответ Сообщение было отмечено как решение

Решение

Visual Basic
1
2
3
4
5
6
7
8
Private Sub CommandButton1_Click()
Dim FileN$
FileN = ThisWorkbook.Path & "" & Date & ".xls"
ThisWorkbook.Sheets(3).Copy
ActiveWorkbook.SaveCopyAs FileN
ActiveWorkbook.Close SaveChanges:=False
MsgBox "Лист № 3 сохранен в новой книге " & FileN
End Sub

Вложения

Тип файла: xls SaveAS.xls (28.5 Кб, 847 просмотров)



7



0 / 0 / 0

Регистрация: 23.01.2012

Сообщений: 6

25.01.2012, 11:51

 [ТС]

7

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

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



0



Эксперт WindowsАвтор FAQ

17993 / 7619 / 890

Регистрация: 25.12.2011

Сообщений: 11,352

Записей в блоге: 17

25.01.2012, 17:35

8

Апострофф, p = ThisWorkbook.Path
Diskretor, FileN = ThisWorkbook.Path & «» & Date & «.xls»
ThisWorkbook.Path меняете на, например, «C:temp»
KoGG, Prefix = «C:temp»



2



0 / 0 / 0

Регистрация: 23.01.2012

Сообщений: 6

25.01.2012, 20:37

 [ТС]

9

Diskretor, Огромное спасибо и тысяча извинений, потому что у меня еще один вопрос… Теперь как сделать чтобы сохранение производилось в той папке где находится книга но в отдельную папку так чтобы это не влияло на первоначальный путь….. Простите я сам не понял что написал……
Ладно покажу так. Например
Сечас у меня сохраняет «D:ДокументыОтчеты» Все отлично, но если поменять имя папки «Документы» на «База» то нужно заходить опять в код программы и менять путь. Вопрос как этого избежать. Сама книга находится в той же папке где папка для сохранения «Отчеты»



0



Апострофф

Заблокирован

25.01.2012, 21:42

10

Лучший ответ Сообщение было отмечено как решение

Решение

Visual Basic
1
FileN = ThisWorkbook.Path & "Отчеты" & Date & ".xls"

Это поправка в код Diskretor`а на

Цитата
Сообщение от Klim_ul
Посмотреть сообщение

Вопрос как этого избежать.

Не по теме:

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

ThisWorkbook.Sheets(3).Copy

Даже не догадывался, что подобная команда соэдает новую книгу с указанным листомО_о



4



Dragokas

Эксперт WindowsАвтор FAQ

17993 / 7619 / 890

Регистрация: 25.12.2011

Сообщений: 11,352

Записей в блоге: 17

25.01.2012, 23:56

11

Лучший ответ Сообщение было отмечено как решение

Решение

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

Visual Basic
1
2
3
4
5
6
7
8
9
10
Option Explicit
Option Base 1
Sub aa()
Dim arSheets$(), a%
ReDim arSheets(Sheets.Count - 1)
For a = 1 To Sheets.Count - 1
    arSheets(a) = ThisWorkbook.Sheets.Item(a).Name
Next
ThisWorkbook.Sheets(arSheets).Copy
End Sub

P.S. ради интереса проверил. Можно подставлять и Integer массив с номерами листов. Эффект будет такой же:

Visual Basic
1
2
3
4
5
6
7
8
9
10
Option Explicit
Option Base 1
Sub aa()
Dim arSheets%(), a%
ReDim arSheets(Sheets.Count - 1)
For a = 1 To Sheets.Count - 1
    arSheets(a) = a
Next
ThisWorkbook.Sheets(arSheets).Copy
End Sub



5



DanAttess

0 / 0 / 0

Регистрация: 29.05.2012

Сообщений: 3

29.05.2012, 10:55

12

А как можно скопировать 2 вполне определенных листа.
Будет ли работать:

Visual Basic
1
2
3
ThisWorkbook.Sheets(2).Copy
ThisWorkbook.Sheets(3).Copy
ActiveWorkbook.SaveCopyAs FileN

?



0



Апострофф

Заблокирован

29.05.2012, 13:02

13

Visual Basic
1
2
ThisWorkbook.Sheets(Array(2, 3)).Copy
ActiveWorkbook.SaveCopyAs FileN

DanAttess, а почитать, что Diskretor постом выше написал не судьба?
Ваш код создаст две новые книги с одним листом в каждой, причём сохранит только последнюю!



1



DanAttess

0 / 0 / 0

Регистрация: 29.05.2012

Сообщений: 3

29.05.2012, 18:05

14

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

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

Visual Basic
1
2
3
With Sheets("sheet1").UsedRange
.Value = .Value
End With



0



Апострофф

Заблокирован

29.05.2012, 18:29

15

Цитата
Сообщение от DanAttess
Посмотреть сообщение

если использовать массивы не получается

Не опускаем руки, делаем с массивами

Visual Basic
1
2
3
4
5
6
7
Dim ws As Worksheet
ThisWorkbook.Sheets(Array(2, 3)).Copy
For Each ws In ActiveWorkbook.Worksheets
  With ws.UsedRange
    .Value = .Value
  End With
Next ws



1



0 / 0 / 0

Регистрация: 23.07.2012

Сообщений: 7

23.07.2012, 13:38

16

Здравствуйте. В экселе не шибко силен. Кто-нибудь может выложить файл с таким примером: чтобы при нажатии кнопки «сохранить» сохранялся допустим лист 2 (на котором будет таблица с формулами), но чтобы сохранялся лист не с формулами, а со значениями, стиль шрифта, размеры столбцов, границы таблицы желательно оставить неизменными. При этом чтобы можно было выбирать путь сохранения и имя файла (или второй вариант — фиксированный путь сохранения и имя файла, допустим сделать 2 кнопки с разными способами сохранения). Честно пытался разобраться с представленными здесь способами, но знаний маловато. Думаю по примеру было бы проще сообразить что к чему



0



1121 / 229 / 36

Регистрация: 15.03.2010

Сообщений: 698

23.07.2012, 15:13

17

Здравствуйте. В экселе не шибко силен. Кто-нибудь может выложить файл с таким примером: чтобы при нажатии кнопки «сохранить» сохранялся допустим лист 2 …

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



1



0 / 0 / 0

Регистрация: 23.07.2012

Сообщений: 7

24.07.2012, 07:55

18

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

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



0



Dragokas

Эксперт WindowsАвтор FAQ

17993 / 7619 / 890

Регистрация: 25.12.2011

Сообщений: 11,352

Записей в блоге: 17

24.07.2012, 14:56

19

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub Into_New_Book()
Dim Ar(), ArAll&(), Sh As Excel.Worksheet, n
Ar = Array(2, 3) 'порядковые номера сохраняемых листов с формулами
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
ActiveWorkbook.Sheets(Ar(0)).Activate
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
  End If
Next
Application.DisplayAlerts = False
  ActiveWorkbook.Worksheets(ArAll).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Dialogs(xlDialogSaveAs).Show
End Sub

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



1



0 / 0 / 0

Регистрация: 23.07.2012

Сообщений: 7

24.07.2012, 15:58

20

Превосходно! Спасибо большое. Подскажите еще пожалуйста, что надо изменить, если этих листов листов не 2 а 20? И другой вопрос сразу: можно сделать так чтобы из этих 20 листов сохранялись не все, а выборочные — в зависимости от условий. К примеру если ячейка А1=0, то сохраняются листы 2-15, если А1=1, то листы 2-18, если А1=2, то лист 19, если А1=3, то листы 2-20. Понятно что слишком замудрено, но такое возможно или вообще никак?



0



Сохранение листа в из книги как отдельный файл.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​ в скопированных листах​ чтобы сохранение производилось​

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

​отдельную от чего?​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​:D
​ а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 с помощью макроса

​ — поле «Имя​​ ветки.​TRC.INFO «Функция дополнительной​Optional ByVal sRngDelList​ » & Range(«B1»).Text​ возвращают ссылку на​

​ из моей надстройки​:​ обратной задачи: есть​ объедененная, то теряется​ подставлять и Integer​

​: 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 =​
​ и нр. счета​

​: Андрей, я не​​ — «Как сохранить​Для основных типов файлов​ лист как отдельный​

​ удаляет все за​
​Option Explicit Option​
​ & «.xls» ThisWorkbook.Sheets(3).Copy​ sFiles = Dir​ он же не​
​.Close (True)​
​ Then End ActiveWorkbook.SaveAs​

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​

Понравилась статья? Поделить с друзьями:
  • Сохранить лист excel в отдельный файл csv
  • Сохранить документ excel в формате pdf онлайн
  • Сохранить лист excel в новую книгу
  • Сохранить датафрейм в excel python
  • Сохранить лист excel в новой книге vba