This worked for me. I am not sure it is exactly what you are trying to do:

Sub AFDataToNewSheets()
Dim ws As Worksheet
Dim i As Integer
Dim curWks As Worksheet
Dim MyCell As Range
Dim NumRqdSheets As Integer
Dim RngF As Range
Dim ExistingFilterRng As Range
Dim FilterColumnWithState As Long

Application.DisplayAlerts = False ' Delete all existing sheets, except
Sheet1
For Each ws In Worksheets
If ws.Index 1 Then
ws.Delete
End If
Next ws
Application.DisplayAlerts = True
Set curWks = Worksheets("sheet1")
FilterColumnWithState = 5 'column in the autofiltered data

With curWks
If .AutoFilterMode = False Then
MsgBox "Please apply Data|Filter|Autofilter"
Exit Sub
End If

Set ExistingFilterRng = .AutoFilter.Range

With ExistingFilterRng
.Columns(FilterColumnWithState).AdvancedFilter _
Action:=xlFilterInPlace, Unique:=True
Set RngF = Nothing
On Error GoTo 0
Set RngF = .Columns(FilterColumnWithState).Offset(1, 0) _
.Resize(.Rows.Count - 1).Cells _
.SpecialCells(xlCellTypeVisible)
NumRqdSheets = RngF.Rows.Count
On Error GoTo 0
End With
If RngF Is Nothing Then
'shouldn't happen
MsgBox "something bad happened"
Exit Sub
End If

For Each MyCell In RngF.Cells
If .FilterMode Then
.ShowAllData
End If
With Worksheets
Set sh = .Add(after:=.Item(.Count))
sh.Name = MyCell.Text
End With
' ** Bomb Taking place on Next line **
With ExistingFilterRng
.AutoFilter Field:=FilterColumnWithState, _
Criteria1:=MyCell.Value
.Parent.AutoFilter.Range.Copy
sh.Paste Destination:=Range("A1")
End With
Next MyCell

End With
Sheets("Sheet1").Activate
End Sub

--
Regards,
Tom Ogilvy


"JMay" wrote:

Am having trouble with following macros on line 51 (and likely beyond..). Can
someone assist? Getting R/T 424 Obj required error

Thank in advance,,

Sub AFDataToNewSheets()
Dim ws As Worksheet
Dim i As Integer
Dim curWks As Worksheet
Dim MyCell As Range
Dim NumRqdSheets As Integer
Dim RngF As Range
Dim ExistingFilterRng As Range
Dim FilterColumnWithState As Long

Application.DisplayAlerts = False ' Delete all existing sheets, except
Sheet1
For Each ws In Worksheets
If ws.Index 1 Then
ws.Delete
End If
Next ws
Application.DisplayAlerts = True
Set curWks = Worksheets("sheet1")
FilterColumnWithState = 5 'column in the autofiltered data

With curWks
If .AutoFilterMode = False Then
MsgBox "Please apply Data|Filter|Autofilter"
Exit Sub
End If

Set ExistingFilterRng = .AutoFilter.Range

With ExistingFilterRng
.Columns(FilterColumnWithState).AdvancedFilter _
Action:=xlFilterInPlace, Unique:=True
Set RngF = Nothing
On Error GoTo 0
Set RngF = .Columns(FilterColumnWithState).Offset(1, 0) _
.Resize(.Rows.Count - 1).Cells _
.SpecialCells(xlCellTypeVisible)
NumRqdSheets = RngF.Rows.Count
On Error GoTo 0
End With

If RngF Is Nothing Then
'shouldn't happen
MsgBox "something bad happened"
Exit Sub
End If

For Each MyCell In RngF.Cells
With Worksheets
.Add(after:=.Item(.Count)).Name = MyCell.Text
End With
' ** Bomb Taking place on Next line **
ExistingFilterRng.Columns(FilterColumnWithState) _
.AutoFilter Field:=1, Criteria1:=MyCell.Value _
.SpecialCells(xlCellTypeVisible).Copy
.Paste Destination:=Range("A1")
Next MyCell
.AutoFilterMode = False

ExistingFilterRng.AutoFilter
End With
Sheets("Sheet1").Activate
End Sub