Macro to create separate worksheet based on Column value

Hello EE.
I am not very experienced with Macros (but studying them), but I know I most likely need one to handle the project I am currently working on.

Each month, we pull a report of fire district fees from our tax system.  We dump the data into Excel (see the worksheet tab "Data - Per IT"),  We click the "SORT" button which then populates the tab "REPORT-All Fire Dists".  This portion of the report is fine.  

However, after this step, they have been manually copying and pasting the individual data for each fire station into a separate worksheet.  These worksheets mirror the tab "Report-All Fire Dists" and we want to be able to use a macro to do this automatically for us each month rather than copy and paste the data.  I want it to allow for at least 8000 lines of data (what I have given you is a small sample with only 3 fire districts).

The three separate fire district worksheets reveal the end result I am looking for.
The macro can either:
1) create the entire worksheet each time for each fire district
or
2) populate an existing worksheet (meaning I could create a template for each of the fire departments and the macro would copy and paste the information from "Report-All Fire Dists" only for the relevant fire district.)

Thanks for any assistance you can provide with this.  Please see my sample file attached.
Experts-Exchange-Example-Fire-Dist-.xlsm
Johnette ConnelleyBudget Analyst / ProjectsAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rgonzo1971Commented:
Hi,

pls try (be sure to have a sheet named template with the first 7 rows already prepared)
Sub SplitDataBasedOnColumnE()
Dim dataWS As Worksheet, WS As Worksheet
Dim dict, x
Dim i As Long, lr As Long

Application.ScreenUpdating = False
Set dataWS = Sheets("REPORT - All Fire Dists")
lr = dataWS.Cells(Rows.Count, 1).End(xlUp).Row

x = dataWS.Range("E7:E" & lr).Value
Set dict = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(x, 1)
    If x(i, 1) <> "" Then
        dict.Item(Split(x(i, 1), " ")(0)) = ""
    End If
Next i

If dict.Count = 0 Then
    MsgBox "No data found in column E.", vbExclamation, "Data Not Found!"
    Exit Sub
End If

dataWS.AutoFilterMode = False
For Each it In dict.Keys
    On Error Resume Next
    Set WS = Sheets(it)
    WS.Range("7:" & Rows.Count).Cells.Clear
    On Error GoTo 0
    If WS Is Nothing Then
        Sheets("Template").Copy before:=Sheets("Template")
        Set WS = ActiveSheet
        WS.Name = it
    End If
    With dataWS.Rows(6)
        .AutoFilter Field:=5, Criteria1:=it & "*"
        Range(dataWS.Range("A7"), dataWS.Range("T" & dataWS.Range("A" & Rows.Count).End(xlUp).Row)).SpecialCells(xlCellTypeVisible).Copy WS.Range("A8")
        Set WS = Nothing
    End With
Next it
dataWS.AutoFilterMode = False
dataWS.Activate
Application.ScreenUpdating = True
End Sub

Open in new window

Regards
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Rgonzo1971Commented:
or with complete fire district name
Sub SplitDataBasedOnColumnE()
Dim dataWS As Worksheet, WS As Worksheet
Dim dict, x
Dim i As Long, lr As Long

Application.ScreenUpdating = False
Set dataWS = Sheets("REPORT - All Fire Dists")
lr = dataWS.Cells(Rows.Count, 1).End(xlUp).Row

x = dataWS.Range("E7:E" & lr).Value
Set dict = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(x, 1)
    If x(i, 1) <> "" Then
        dict.Item(x(i, 1)) = ""
    End If
Next i

If dict.Count = 0 Then
    MsgBox "No data found in column E.", vbExclamation, "Data Not Found!"
    Exit Sub
End If

dataWS.AutoFilterMode = False
For Each it In dict.Keys
    On Error Resume Next
    Set WS = Sheets(it)
    WS.Range("7:" & Rows.Count).Cells.Clear
    On Error GoTo 0
    If WS Is Nothing Then
        Sheets("Template").Copy before:=Sheets("Template")
        Set WS = ActiveSheet
        WS.Name = it
    End If
    With dataWS.Rows(6)
        .AutoFilter Field:=5, Criteria1:=it
        Range(dataWS.Range("A7"), dataWS.Range("T" & dataWS.Range("A" & Rows.Count).End(xlUp).Row)).SpecialCells(xlCellTypeVisible).Copy WS.Range("A8")
        Set WS = Nothing
    End With
Next it
dataWS.AutoFilterMode = False
dataWS.Activate
Application.ScreenUpdating = True
End Sub

Open in new window

0
Johnette ConnelleyBudget Analyst / ProjectsAuthor Commented:
I cannot thank you enough for writing this macro for me.  I learn so much from working with you all and you all make me look like a rockstar at work!  Thanks!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.