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

Рассмотрим следующий пример: вы создаете опросный лист, персонализированный для каждого участника (указывается, как вариант, название подразделения организации). Делаете вы это в одной книге с множеством листов.

Для отправки «опросника» на заполнение в подразделения требуется каждый лист этой книги выделить в отдельную книгу. Непростая задача, если листов не 1-2, а несколько десятков или сотен.

Для этой задачи – разделения книги с множеством листов на множество книг – создадим процедуру.

Sub CopySheetsToWB()

    Dim aSheet As Worksheet
    Dim toSheet As Worksheet
    Dim aWB As Workbook
    Dim toWB As Workbook
    Dim toWBFilename As String

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    Set aWB = ActiveWorkbook

    For Each aSheet In aWB.Sheets
        Set toWB = Workbooks.Add
        aSheet.Copy Before:=toWB.Sheets(1)
        For Each toSheet In toWB.Sheets
            If toSheet.Visible <> xlSheetVisible Then toSheet.Visible = xlSheetVisible
            If toSheet.Name <> aSheet.Name Then toSheet.Delete
        Next
        With toWB
            toWBFilename = aWB.Path & "/" & Replace(aSheet.Name, """", "")
            toWBFilename = toWBFilename
            .SaveAs Filename:=toWBFilename, FileFormat:=xlWorkbookDefault
            .Close
        End With
        Set toWB = Nothing
    Next

    Set aWB = Nothing

    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub
КодОписание
Dim aSheet As Worksheet
Переменная aSheet указывает на лист, подлежащий переносу в новую книгу
Dim toSheet As Worksheet
Переменная toSheet указывает на лист, содержащийся в новой книге
Dim aWB As Workbook
Переменная aWB указывается на текущую книгу, из которой выделяются листы
Dim toWB As Workbook
Set toWB = Workbooks.Add
Переменная aWB указывается на новые книги, в которые копируются листы
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

Код запрещает на время исполнения процедуры:

  • Отображать уведомления об ошибках и запросы (например, на удаление пустых листов в новых книгах)
  • Обновление экрана – необходимо для повышения быстродействия кода
Set aWB = ActiveWorkbook
Указываем, что в качестве объекта процедуры будет использована активная книга (отображаемая на экране)
For Each aSheet In aWB.Sheets

Next
Процедура выделения листов в отдельные книги
aSheet.Copy Before:=toWB.Sheets(1)
Копируем лист в новую книгу
For Each toSheet In toWB.Sheets
    If toSheet.Visible <> xlSheetVisible Then toSheet.Visible = xlSheetVisible
    If toSheet.Name <> aSheet.Name Then toSheet.Delete
Next

Проводим следующие манипуляции с новой книгой:

  • Делаем все листы в книге видимыми (если в основной книге лист был скрыт)
  • Удаляем пустые листы, оставляем только выделенный
With toWB
    toWBFilename = aWB.Path & "/" & Replace(aSheet.Name, """", "")
    toWBFilename = toWBFilename
    .SaveAs Filename:=toWBFilename, FileFormat:=xlWorkbookDefault
    .Close
End With
Сохраняем новую книгу с именем файла, соответствующим названию листа и закрываем ее
Set toWB = Nothing
Set aWB = Nothing
Очищаем память

 

Скачать для Excel 2003, Excel 2007+

Добавить комментарий


Защитный код
Обновить

Вверх