Скопировать каждый лист+1 в отдельный файл

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Скопировать каждый лист+1 в отдельный файл (Макросы/Sub)

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 попал ко всем файлам?

Ответить

Karataev

Дата: Воскресенье, 15.05.2016, 16:03 | Сообщение № 2

Группа: Проверенные

Ранг: Старожил

Сообщений: 1334

Репутация: 533 ±

Замечаний: 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

Ответить

letasm

Дата: Воскресенье, 15.05.2016, 16:30 | Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 37

Репутация: 0 ±

Замечаний: 40% ±

Excel 2010

Спасибо огромнейшее! Все работает! Karataev,

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Скопировать каждый лист+1 в отдельный файл (Макросы/Sub)

Страница 1 из 1
1