Hello,
I developed another macro which uses an iterateing range search command instead of a pivot table. So with this one, you don't have to create a separate pivot table or create a named range. This will work straight from the orginal workbook you provided. I think the above code is well written code, I am also not claiming to be a macro expert, I am just posting all I can so I won't be a "Novice" anymore.

So with this, you do have to rename the original sheet with all your data to "Original". So rename the sheet, hit Alt + F11, and copy and paste the following code into the VB window, hit play and you are good to go:

Sub biffur()
Dim easy As Range, fnd As Range
Dim numrow As Long
Dim szstate As String, sztmp As String
Dim wrkbk As Workbook
Dim origsht As Worksheet, wrksht As Worksheet

Application.ScreenUpdating = False

Set wrkbk = ActiveWorkbook
Set origsht = wrkbk.Sheets("Original")
sztmp = origsht.Name
Set easy = origsht.Range("B2")
numrow = easy.End(xlDown).Row - 2

For i = 1 To numrow
origsht.Select
easy.Offset(i, 0).Select
szstate = ActiveCell.Value
If shtexsts(szstate) = False Then
With origsht.Range("B2:B2000")
Set fnd = .Find(szstate, LookIn:=xlValues)
If Not fnd Is Nothing Then
firstAddress = fnd.Address
Do
iter = iter + 1
Set fnd = .FindNext(fnd)
Loop While Not fnd Is Nothing And fnd.Address <> firstAddress
End If
End With
Set wrksht = wrkbk.Sheets.Add
wrksht.Move After:=Sheets(sztmp)
wrksht.Name = szstate
Range("B2").Value = "State"
Range("C2").Value = "Zone"
For j = 1 To iter
Range("B2").Offset(j, 0).Value = szstate
Next j
sztmp = szstate
End If
Next i
Application.ScreenUpdating = True
End Sub

Function shtexsts(shtnm As String) As Boolean
On Error Resume Next
shtexsts = CBool(Len(Sheets(shtnm).Name))
End Function

Regards,
Math Nerd