Option Explicit
Sub CreateStateTabs()
Dim oStates As Collection
Dim c As Range
Dim i As Integer
Dim sActiveSheet As String
sActiveSheet = ActiveSheet.Name
Set oStates = New Collection
For Each c In Intersect(ActiveSheet.UsedRange, Range("A:A"))
If c.Row > 1 Then
On Error Resume Next
oStates.Add c.Value, c.Value
End If
Next c
On Error GoTo 0
For i = 1 To oStates.Count
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name _
= oStates.Item(i)
Next i
Set oStates = Nothing
CopyDataToStateTabs sActiveSheet
End Sub
Sub CopyDataToStateTabs(SourceSheet As String)
Dim sht As Worksheet
With Worksheets(SourceSheet)
.Activate
Range("A1").Select
Selection.AutoFilter
ActiveSheet.UsedRange.Select
For Each sht In Worksheets
If sht.Name <> SourceSheet Then
Selection.AutoFilter Field:=1, Criteria1:=sht.Name
Selection.Copy
sht.Range("A1").PasteSpecial xlPasteAll
End If
Next sht
.Select
End With
Application.CutCopyMode = False
Selection.AutoFilter
Range("A1").Select
End Sub