I have an Excel 2010 workbook (let's call it 'Master') with two worksheets, Sheet1 and Sheet2.
Each worksheet has data structured as shown below. One of the columns (in this example, Column1_header) has an identifier, such as a zip code. Both sheets on the Master are sorted on Column1_header.
The example below illustrates the structure of both worksheets.
Note: The actual structure is slightly different, in that Sheet2 contains additional columns, and different data and number of rows associated with each zip code.
Column1_header Col2_header Col3_header 11111 a aaa 11111 b bbb 11111 c ccc 22222 d ddd 22222 e eee 33333 g ggg
What I need is to split the Master into multiple separate Workbooks, such that:
- There is a separate output file (workbook) for each Column1_header value.
The name of each output file contains the associated Column1header value (e.g. "11111_data.xlsx", "22222_data.xlsx", etc.).
Each output file workbook replicates the structure of Master, i.e. has the same two worksheets, Sheet1 and Sheet2. Each worksheet has the same look and formatting as they do on the Master.
- The worksheets on each separate output file contain ONLY the rows for the associated Column1_header value (e.g. "11111"). So file "11111_data.xlsx" would contain Sheet1 with the 3 rows for "11111", and Sheet2 with however many rows associated with "11111" on that sheet.
- Any formatting, such as column width, cell color, font size, etc. on the column headers on the Master are preserved in the split-up files, and (ideally) the column filter buttons.
I know it takes a VBA macro, but have novice VBA experience. I have an macro for splitting a single worksheet and copying some additional worksheets (here on Code Review), but it only filtered one worksheet and I couldn't quite get it to do what I need here.
I see a similar question here on SuperUser but it's for a single worksheet whereas the key issue here is doing this for multiple worksheets. Other examples online, e.g. here and here, but none of them get the job done.
UPDATE: The code below does the job for a single worksheet. What I need is to replicate this processing so it works for several worksheets. I am guessing it is a relatively straight-forward tweak but could use some help figuring out how to get it to work.
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