У меня есть книга Excel 2010 (назовем ее « Мастер ») с двумя листами, Sheet1 и Sheet2.

Каждый лист имеет данные, структурированные как показано ниже. Один из столбцов (в этом примере, Column1_header) имеет идентификатор, такой как почтовый индекс. Оба листа на Master отсортированы по Column1_header.

Пример ниже иллюстрирует структуру обеих таблиц.

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

Column1_header  Col2_header Col3_header
11111           a           aaa
11111           b           bbb
11111           c           ccc
22222           d           ddd
22222           e           eee
33333           g           ggg

Что мне нужно, это разделить Мастер на несколько отдельных книг, так что:

  • Для каждого значения Column1_header существует отдельный выходной файл (рабочая книга).

  • Имя каждого выходного файла содержит соответствующее значение Column1header (например, «11111_data.xlsx», «22222_data.xlsx» и т.д.).

  • Каждая рабочая книга выходного файла повторяет структуру Master, то есть имеет те же две рабочие таблицы, Sheet1 и Sheet2. Каждый лист имеет тот же внешний вид и формат, что и на Мастер.

  • Рабочие таблицы в каждом отдельном выходном файле содержат ТОЛЬКО строки для соответствующего значения Column1_header (например, "11111"). Таким образом, файл «11111_data.xlsx» будет содержать Sheet1 с 3 строками для "11111" и Sheet2 с любым количеством строк, связанных с "11111" на этом листе.
  • Любое форматирование, такое как ширина столбца, цвет ячейки, размер шрифта и т.д. В заголовках столбцов на Master, сохраняется в разделенных файлах и (в идеале) кнопках фильтрации столбцов.

Я знаю, что требуется макрос VBA, но у меня есть опыт начинающих VBA. У меня есть макрос для разделения одного листа и копирования некоторых дополнительных листов (здесь, в Code Review), но он отфильтровал только один лист, и я не мог заставить его делать то, что мне нужно здесь.

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

ОБНОВЛЕНИЕ: приведенный ниже код выполняет работу для одного листа. Что мне нужно, это повторить эту обработку, чтобы она работала для нескольких листов. Я предполагаю, что это относительно простой твик, но может помочь понять, как заставить его работать. 

Sub parse_by_id()

Dim r As Long, rng As Range, ws As Worksheet
Dim lastRow As Integer

Application.DisplayAlerts = False
Application.ScreenUpdating = False

With Sheets("Test1") 'Sheet1
    Sheets.Add().Name = "temp"
    .Range("D12", .Range("D" & Rows.Count).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("temp").Range("D12"), Unique:=True
     For Each rng In Sheets("temp").Range("D13", Sheets("temp").Range("D13").End(xlDown))
        .AutoFilterMode = False
        .Range("D12").AutoFilter field:=4, Criteria1:=rng 'field:=3
        Set ws = Sheets.Add

        lastRow = .Range("B12:F12").End(xlDown).Row 
        .Range("B12:bi" & lastRow).SpecialCells(xlCellTypeVisible).Copy 
        ws.Range("B12").PasteSpecial xlPasteColumnWidths
        ws.Range("B12").PasteSpecial xlPasteAll
        .Range("B2:bi11").Copy ws.Range("B2")   
        Columns("A:A").ColumnWidth = 1

        For r = 1 To lastRow
            ws.Rows(r).RowHeight = .Rows(r).RowHeight
        Next r

        ws.Range("B3:F3").MergeCells = True 
        ws.Name = rng
        ws.Move
        .AutoFilterMode = False
        Rows.Hidden = False
        Columns.Hidden = False
        ActiveWindow.DisplayGridlines = False
        Range("D13").Select
    ActiveWindow.FreezePanes = True
    ActiveWindow.Zoom = 95 
        ActiveWorkbook.Close SaveChanges:=True, Filename:="C:\TEMP\" & rng & "-testfile.xlsx"
    Next rng
      Sheets("temp").Delete
End With
|источник

0