Copy Auto-filtered data to new sheets

[JMay]

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

 

[Tom Ogilvy]

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

 

[p45cal]

Was this line:

' ** Bomb Taking place on Next line **
ExistingFilterRng.Columns(FilterColumnWithState) _
..AutoFilter Field:=1, Criteria1:=MyCell.Value _
..SpecialCells(xlCellTypeVisible).Copy
..Paste Destination:=Range("A1")

a tad long (with a line continuation line too many?) and maybe should be
something like:

ExistingFilterRng.Columns(FilterColumnWithState).AutoFilter Field:=1,
Criteria1:=MyCell.Value
ExistingFilterRng.SpecialCells(xlCellTypeVisible).Copy
.Paste Destination:=Range("A1")


depending on what you're trying to achieve.
--
p45cal

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,,

[snip]

 

[JMay]

Thanks guys, I got it!!

Was this line:

' ** Bomb Taking place on Next line **
ExistingFilterRng.Columns(FilterColumnWithState) _
.AutoFilter Field:=1, Criteria1:=MyCell.Value _
.SpecialCells(xlCellTypeVisible).Copy
.Paste Destination:=Range("A1")

a tad long (with a line continuation line too many?) and maybe should be
something like:

ExistingFilterRng.Columns(FilterColumnWithState).AutoFilter Field:=1,
Criteria1:=MyCell.Value
ExistingFilterRng.SpecialCells(xlCellTypeVisible).Copy
.Paste Destination:=Range("A1")


depending on what you're trying to achieve.
--
p45cal

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,,

[snip]

 

[JMay]

Tom: What is this line doing (near end)..

..Parent.AutoFilter.Range.Copy

can't find answer googling
TIA,
Jim

 

[Dave Peterson]

Your code looks like this:

With ExistingFilterRng
.AutoFilter Field:=FilterColumnWithState, _
Criteria1:=MyCell.Value
.Parent.AutoFilter.Range.Copy

which is essentially this line (for the .copy)

ExistingFilterRng.Parent.AutoFilter.Range.Copy

The parent of the range is the worksheet that owns the range. So you're copying
the autofilter range from the same worksheet that owns the existingfilterrng
(same as curwks or Sheet1 in your code).

 

[JMay]

I was thinking it was something like you said..
BUT YOU NAILED IT !!
Tks Dave
Jim