Copy Cells to New Sheet If First Cell Matches Certain Criteria

[e_tietze]

I'm working on Excel 2011 for Macintosh. I have a spreadsheet of about 900 entries of businesses with contact information and categories they fit into. The first cell is the category name, ie. buildings & construction, feed & farm supply, etc... I'm wanting to setup so that all of the business listed on the main sheet which are in the category of Buildings & Construction will be copied to another sheet by themselves, same for Feed & Farm Supply and so forth.

I essentially want to end up with one primary sheet with the entire list then worksheets for each of the 14 categories.

Thanks in advance for any help!

 

[mumps]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim CategoryName As Range
    Dim c As Range
    Dim ws As Worksheet
    Sheets("Sheet1").Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
        ("A1:A" & LastRow), Unique:=True
    Set rnguniques = Sheets("Sheet1").Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible)
    For Each CategoryName In rnguniques
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(CategoryName.Value)
        On Error GoTo 0
        If ws Is Nothing Then
                Worksheets.Add(After:=Sheets(Sheets.Count)).Name = CategoryName.Value
        End If
    Next CategoryName
    For Each c In rnguniques
        For Each ws In Sheets
            If ws.Name = c Then
                Sheets("Sheet1").Range("$A$1:$A$" & LastRow).AutoFilter Field:=1, Criteria1:=c
                Sheets("Sheet1").Range("$A$2:$A$" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets(ws.Name).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
        Next ws
    Next c
    If Sheets("Sheet1").FilterMode Then Sheets("Sheet1").ShowAllData
    Application.ScreenUpdating = True
End Sub