Split Worksheet Into Multiple Workbooks Based on Column Value

[phipsijuice]

Hi!

Using VBA I'd like to split an Excel worksheet into multiple workbooks based on each unique value in Column B. The header name for Column B is "Acronym". Each Workbook would contain the same column headers as the master file. The Excel format is .xlsx

I want the file name to be "Column B Value Quarterly Shipping Report"; an example would be "NAHB Quarterly Shipping Report" The workbooks would be split in the same folder as the master file.

Any help would be greatly appreciated!

Stephen

 

[wellsr]

This should do the trick for you:

Sub CopyWorksheet()Dim b As Integer, lastrow As Integer, lastcol As Integer
Dim wb As Workbook, wbCurr As Workbook
Dim strPath As String, strVal As String


strPath = Application.ActiveWorkbook.Path
Set wbCurr = ActiveWorkbook
lastrow = ActiveSheet.Range("b100000").End(xlUp).Row
lastcol = ActiveSheet.Range("xfd1").End(xlToLeft).Column
For b = 2 To lastrow
    strVal = Range("b" & b)
    Set wb = Workbooks.Add
    ThisWorkbook.Activate
    ActiveSheet.Range(Cells(1, 1), Cells(1, lastcol)).Copy
    wb.Activate
    wb.ActiveSheet.Range("a1").PasteSpecial (xlPasteValues)
    wb.SaveAs strPath & "\" & strVal & "Quarterly Shipping Report.xlsx"
    wbCurr.Activate
Next b
End Sub

It copies the top row (header) to each new workbook with name based on the Column B value and path based on the original workbook's path.