How to Create Multiple Files From a Column in Excel

I was recently asked how to create multiple files in Excel from unique values in a specific column. The user wanted to copy all the data in each row where the values were identical to each new file, plus the header. My first thought was to use Python. However, VB scripting is often overlooked these days. I also can’t install Python on everyone’s PC every time this is needed.

This script looks at data in column A. For each unique value, it will create a new file with the name of the value found. Then, it will copy the header and all the matching rows to the new file. It then saves and exits the new file and loops through until it has created a new file for all unique values.

I’ll admit, it has been a minute since I’ve done any actual VB scripting. The rust was thick here.

Sub SplitDataIntoWorkbooks()
    Dim sourceSheet As Worksheet
    Dim destinationWorkbook As Workbook
    Dim destinationSheet As Worksheet
    Dim lastRow As Long, i As Long
    Dim cellValue As Variant
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Set sourceSheet = ThisWorkbook.Sheets("YourSheetName") ' Set this to your sheet name
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row

    ' Loop to collect unique values from column A - this assumes you have a header row
    For i = 2 To lastRow
        cellValue = sourceSheet.Cells(i, 1).value
        If Not dict.exists(cellValue) Then
            dict.Add cellValue, Nothing
        End If
    Next i

    ' Loop through each unique value to create new workbooks
    For Each cellValue In dict.keys
        Set destinationWorkbook = Application.Workbooks.Add
        Set destinationSheet = destinationWorkbook.Sheets(1)

        ' Copy header row to new workbooks
        sourceSheet.Rows(1).Copy Destination:=destinationSheet.Rows(1)

        ' Copy rows for current unique value - start at row 2 so we don't overwrite the header
        For i = 2 To lastRow
            If sourceSheet.Cells(i, 1).value = cellValue Then
                sourceSheet.Rows(i).Copy Destination:=destinationSheet.Cells(destinationSheet.Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
        Next i

        ' Save the new workbook and exit
        destinationWorkbook.SaveAs "C:\YourPath\" & cellValue & ".xlsx" ' Change to your desired path
        destinationWorkbook.Close False
    Next cellValue
End Sub

Instructions for Using the Script

Open Excel: Navigate to the workbook containing your data.
Press Alt + F11: This opens the VBA Editor.
Insert a Module: Right-click on any of the objects in the Project window, go to Insert, and select Module. This creates a new module.
Copy and Paste the Script: Copy the VBA script provided above and paste it into the newly created module. Change "YourSheetName" to the actual name of your sheet and "C:\YourPath\" to the desired save path on your computer.
Run the Script: Press F5 while in the VBA Editor to run the script.

Enjoy!