View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
JMay JMay is offline
external usenet poster
 
Posts: 468
Default Copy Auto-filtered data to new sheets

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