Como dividir várias planilhas de dados por valor de coluna e saída para arquivos separados?

Question

Eu tenho uma pasta de trabalho do Excel 2010 (vamos chamá-la de ' Mestre ') com duas planilhas, Sheet1 e Sheet2.

Cada planilha possui dados estruturados conforme mostrado abaixo. Uma das colunas (neste exemplo, Column1_header) tem um identificador, como um código postal. Ambas as folhas no mestre são classificadas em Column1_header.

O exemplo abaixo ilustra a estrutura de ambas as planilhas.

Observação: a estrutura real é ligeiramente diferente, em que Sheet2 contém colunas adicionais e diferentes dados e número de linhas associadas a cada CEP.

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

O que eu preciso é dividir o Master em várias pastas de trabalho separadas, de modo que:

• Existe um arquivo de saída separado (pasta de trabalho) para cada valor de Column1_header.

• O nome de cada arquivo de saída contém o valor associado de Column1header (por exemplo, "11111_data.xlsx", "22222_data.xlsx", etc.).

• Cada pasta de trabalho do arquivo de saída replica a estrutura do mestre, ou seja, tem as mesmas duas planilhas, Sheet1 e Sheet2. Cada planilha tem a mesma aparência e formatação do mestre.

• As planilhas em cada arquivo de saída separado contêm APENAS as linhas para o valor associado Column1_header (por exemplo, "11111"). Portanto, o arquivo "11111_data.xlsx" conteria Sheet1 com as 3 linhas para "11111" e Sheet2 com quantas linhas associadas a "11111" nessa folha.
• Qualquer formatação, como largura da coluna, cor da célula, tamanho da fonte, etc., nos cabeçalhos da coluna do mestre é preservada nos arquivos divididos e (idealmente) nos botões de filtro da coluna.

Sei que é preciso uma macro VBA, mas tenho uma experiência novata em VBA. Eu tenho uma macro para dividir uma única planilha e copiando algumas planilhas adicionais ( aqui no Code Review ), mas ele filtrou apenas uma planilha e não consegui fazer o que eu preciso aqui.

Eu vejo uma pergunta semelhante aqui no SuperUser mas é para uma única planilha, enquanto o principal problema aqui é fazer isso para várias planilhas. Outros exemplos online, por ex. aqui e aqui , mas nenhum deles faz o trabalho.

UPDATE: O código abaixo faz o trabalho para uma única planilha. O que eu preciso é replicar esse processamento para que funcione em várias planilhas. Eu estou supondo que é um ajuste relativamente simples, mas poderia usar alguma ajuda para descobrir como fazê-lo funcionar.

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