Hello all,

I've seen this question come up a few times, "How do I split data from a master sheet into separate sheets?"
I created a macro that is a bit generic so that users can adapt it to their needs.
Here is the macro code:
Sub SplitDataIntoSheetsByCriteria()
'Macro created by TigerAvatar at www.excelforum.com, November 2012
'Purpose is to split the data of a sheet into separate sheets based on a key column

    'Declare constants
    'Adjust these to suit your specific needs
    Const strDataSheet As String = "Sheet1"     'The name of the sheet that contains the data
    Const strCriteriaCol As String = "A"        'The letter of the column that will be evaluated
    Const lHeaderRow As Long = 1                'The number of the Header Row
    
    'Declare variables
    Dim ws As Worksheet             'Used to loop through the worksheets in order to alphabetize them
    Dim wsData As Worksheet         'Used to store the Data Sheet to a worksheet object variable
    Dim rngCriteria As Range        'Used to store the Range on the Data Sheet that will be evaluated
    Dim CriteriaCell As Range       'Used to loop through rngCriteria
    Dim lCalc As XlCalculation      'Used to store the current calculation state of the workbook
    Dim strNameWS As String         'Used to create legal worksheet names
    Dim i As Long                   'Generic looping variable
    
    'Set the wsData and rngCriteria variables using the constants declared at the top of this macro
    Set wsData = Sheets(strDataSheet)
    Set rngCriteria = wsData.Range(strCriteriaCol & lHeaderRow, wsData.Cells(Rows.Count, strCriteriaCol).End(xlUp))
    
    'Store the current calculation state, set calculation to manual, disable events, alerts, and screenupdating
    'This allows the code to run faster and prevents "screen flickering"
    With Application
        lCalc = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    
    'Assume code will fail and provide an error handler
    On Error GoTo CleanExit
    
    'Loop through each cell in rngCriteria
    For Each CriteriaCell In rngCriteria.Cells
        'Make sure the cell is after the Header Row
        If CriteriaCell.Row > lHeaderRow Then
            'Make sure the cell is not blank
            If Len(CriteriaCell.Text) > 0 Then
                
                'Generate a legal worksheet name
                strNameWS = CriteriaCell.Text
                For i = 1 To 7
                    strNameWS = Replace(strNameWS, Mid(":\/?*[]", i, 1), " ")
                Next i
                strNameWS = Left(WorksheetFunction.Trim(strNameWS), 31)
                
                'Check if there is already a sheet with the same name
                If Not Evaluate("IsRef(" & strNameWS & "!A1)") Then
                    'Need to create a new sheet
                    'Add the new sheet, name it appropriately, copy over the information based on the criteria
                    With Sheets.Add(After:=Sheets(Sheets.Count))
                        .Name = strNameWS
                        wsData.Rows(lHeaderRow).EntireRow.Copy .Range("A1")
                        rngCriteria.AutoFilter 1, CriteriaCell.Text
                        rngCriteria.Offset(1).EntireRow.Copy .Range("A2")
                    End With
                End If
            End If
        End If
    Next CriteriaCell
    
    'Alphabetize the worksheets
    For Each ws In ActiveWorkbook.Sheets
        For i = 1 To ActiveWorkbook.Sheets.Count
            If ws.Name < Sheets(i).Name Then ws.Move Before:=Sheets(i)
        Next i
    Next ws
    
    'Set the Data sheet to be the first sheet in the workbook and select that sheet so it is displayed after macro completes
    wsData.Move Before:=Sheets(1)
    wsData.Select
    
'If there were any errors, the code immediately goes here
'The code will also exit here even if there are no errors
CleanExit:
    
    'Remove any remaining filters
    rngCriteria.AutoFilter
    
    'Set calculation back to what it was, re-enable events, alerts, and screenupdating
    With Application
        .Calculation = lCalc
        .EnableEvents = True
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
    'Display the error that occurred (if any) and clear the error
    If Err.Number <> 0 Then
        MsgBox Err.Description, , "Error: " & Err.Number
        Err.Clear
    End If
    
    'Object variable cleanup
    Set ws = Nothing
    Set wsData = Nothing
    Set rngCriteria = Nothing
    Set CriteriaCell = Nothing
    
End Sub

How to use a macro:
  1. Make a copy of the workbook the macro will be run on
    • Always run new code on a workbook copy, just in case the code doesn't run smoothly
    • This is especially true of any code that deletes anything
  2. In the copied workbook, press ALT+F11 to open the Visual Basic Editor
  3. Insert | Module
  4. Copy the provided code and paste into the module
  5. Close the Visual Basic Editor
  6. In Excel, press ALT+F8 to bring up the list of available macros to run
  7. Double-click the desired macro (I named this one SplitDataIntoSheetsByCriteria)