Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Скопировать каждый лист+1 в отдельный файл - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Скопировать каждый лист+1 в отдельный файл (Макросы/Sub)
Скопировать каждый лист+1 в отдельный файл
letasm Дата: Воскресенье, 15.05.2016, 13:57 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
Есть макрос
[vba]
Код
Sub SheetToXlsFile()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each SN In ThisWorkbook.Sheets
Workbooks.Add xlWBATWorksheet 'создание книги с одним листом
ThisWorkbook.Sheets(SN.Index).Cells.Copy ActiveWorkbook.Sheets(1).Cells
ActiveWorkbook.SaveAs (ThisWorkbook.Path & "\" & SN.Name & ".xlsx")
ActiveWorkbook.Close
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
[/vba]
Он проходит по всем листам книги и создает для них отдельные файлы
А нужно немного по-другому: есть листы : лист1, литс 2, лист 3... и так далее и листа Лист0
И надо чтобы получились файлы не с листами лист1, файл с листом лист2, файл с листом 3
а чтобы было файл с листами: лист1 и лист 0, след файл Лист2 и лист 0, чтобы лист0 попал ко всем файлам?
 
Ответить
СообщениеЕсть макрос
[vba]
Код
Sub SheetToXlsFile()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each SN In ThisWorkbook.Sheets
Workbooks.Add xlWBATWorksheet 'создание книги с одним листом
ThisWorkbook.Sheets(SN.Index).Cells.Copy ActiveWorkbook.Sheets(1).Cells
ActiveWorkbook.SaveAs (ThisWorkbook.Path & "\" & SN.Name & ".xlsx")
ActiveWorkbook.Close
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
[/vba]
Он проходит по всем листам книги и создает для них отдельные файлы
А нужно немного по-другому: есть листы : лист1, литс 2, лист 3... и так далее и листа Лист0
И надо чтобы получились файлы не с листами лист1, файл с листом лист2, файл с листом 3
а чтобы было файл с листами: лист1 и лист 0, след файл Лист2 и лист 0, чтобы лист0 попал ко всем файлам?

Автор - letasm
Дата добавления - 15.05.2016 в 13:57
Karataev Дата: Воскресенье, 15.05.2016, 16:03 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 884
Репутация: 332 ±
Замечаний: 0% ±

Excel
Смотрите комментарии в коде. Макрос не тестировал, поэтому возможны какие-нибудь ошибки.
[vba]
Код
Sub SheetToXlsFile()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each SN In ThisWorkbook.Sheets
        'Здесь проверка,что это не лист 0. Вместо нуля запишите имя листа. Или если хотите
        'использовать номер листа, то сделайте так (вместо нуля запишите номер листа 0):
        'If SN.Index <> 0 Then
        If SN.Name <> "0" Then
            Workbooks.Add xlWBATWorksheet 'создание книги с одним листом
            SN.Cells.Copy ActiveSheet.Range("A1")
            ActiveWorkbook.Worksheets.Add After:=ActiveSheet
            'Sheets("0") - это лист 0. Вместо нуля запишите имя листа или номер листа
            '(но в этом случае удалите кавычки: Sheets(0))
            ThisWorkbook.Sheets("0").Cells.Copy ActiveSheet.Range("A1")
            ActiveWorkbook.SaveAs (ThisWorkbook.Path & "\" & SN.Name & ".xlsx")
            ActiveWorkbook.Close
        End If
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
[/vba]




Сообщение отредактировал Karataev - Воскресенье, 15.05.2016, 16:13
 
Ответить
СообщениеСмотрите комментарии в коде. Макрос не тестировал, поэтому возможны какие-нибудь ошибки.
[vba]
Код
Sub SheetToXlsFile()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each SN In ThisWorkbook.Sheets
        'Здесь проверка,что это не лист 0. Вместо нуля запишите имя листа. Или если хотите
        'использовать номер листа, то сделайте так (вместо нуля запишите номер листа 0):
        'If SN.Index <> 0 Then
        If SN.Name <> "0" Then
            Workbooks.Add xlWBATWorksheet 'создание книги с одним листом
            SN.Cells.Copy ActiveSheet.Range("A1")
            ActiveWorkbook.Worksheets.Add After:=ActiveSheet
            'Sheets("0") - это лист 0. Вместо нуля запишите имя листа или номер листа
            '(но в этом случае удалите кавычки: Sheets(0))
            ThisWorkbook.Sheets("0").Cells.Copy ActiveSheet.Range("A1")
            ActiveWorkbook.SaveAs (ThisWorkbook.Path & "\" & SN.Name & ".xlsx")
            ActiveWorkbook.Close
        End If
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - Karataev
Дата добавления - 15.05.2016 в 16:03
letasm Дата: Воскресенье, 15.05.2016, 16:30 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
Спасибо огромнейшее! Все работает! Karataev,
 
Ответить
СообщениеСпасибо огромнейшее! Все работает! Karataev,

Автор - letasm
Дата добавления - 15.05.2016 в 16:30
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Скопировать каждый лист+1 в отдельный файл (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!