Hi again,
I realized that my solution was too slow
Since I couldn't let go of the challenge I decided to try to solve it

@jsmath22: I am not trying to compete with you or anything like that. I just wanted to try to fix this on my own

Anyhow, here is a completely new version, that don't need any pivot table.

Just place the cursor in the cell where the header "State" is (AB13 in your example sheet). Then run the macro. It takes about half a minute to run it for the complete data volume.

Kind regards
Bjorn


Macro:
Sub OneSheetPerState2()
Dim rng1 As Range, rng2 As Range
Dim LastRow1 As Long, LastRow2 As Long, C As Long, Max2 As Long, StateCol As Long, StateRow As Long
Dim DataSheet As String
'Starting commands
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
DataSheet = "original"
Sheets(DataSheet).Select
StateCol = ActiveCell.Column
StateRow = ActiveCell.Row

'Optional: First delete all other sheets
'For C = Sheets.Count To 2 Step -1
' Application.DisplayAlerts = False
' Sheets(C).Delete
' Application.DisplayAlerts = True
'Next C

' Save exclusive states in table State()
With ActiveSheet
LastRow1 = .Cells(.Rows.Count, ActiveCell.Column).End(xlUp).Row
End With

Set rng1 = ActiveSheet.Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(LastRow1, ActiveCell.Column))
ActiveCell.EntireColumn.Offset(0, 1).Insert
rng1.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ActiveCell.Offset(0, 1), Unique:=True
With ActiveSheet
LastRow2 = .Cells(.Rows.Count, ActiveCell.Column + 1).End(xlUp).Row
End With

Set rng2 = ActiveSheet.Range(Cells(ActiveCell.Row, ActiveCell.Column + 1), Cells(LastRow2, ActiveCell.Column + 1))
rng2.Sort Key1:=Cells(ActiveCell.Row, ActiveCell.Column + 1), Order1:=xlAscending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Dim State(2 To 999) As String

Max2 = rng2.Count
For C = 2 To rng2.Count
State(C) = rng2(C)
Next C
ActiveCell.EntireColumn.Offset(0, 1).Delete
' Save the long statelist in table StateListLong()
Dim StateListLong(1 To 65000) As String

For C = StateRow + 1 To LastRow1
StateListLong(C) = Cells(C, StateCol).Value
Next C
' Add one sheet per state
For C = 2 To Max2
Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = State(C)
Sheets(DataSheet).Select
Rows("1:" & StateRow).Select
Selection.Copy
Sheets(State(C)).Select
ActiveSheet.Paste
Cells(StateRow + 1, 1).Select
Next C
Sheets(DataSheet).Select
' Copy every row from original sheet to the next free line in the proper sheet
For C = StateRow + 1 To LastRow1
Sheets(DataSheet).Select
Rows(C).Copy
temp = Cells(C, StateCol)
Sheets(temp).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Range("A1").Select
Next C
'Ending commands
Sheets(DataSheet).Select
Application.CutCopyMode = False
Range("A1").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub