Paseting filtered info into another sheet
 

Hi,

I have used Ron DeBruin's macro to filter and copy to a new sheet. I
have changed it a bit to suit my needs. it worked the first time I ran
the macro. I deleted the created sheets and re run it. Now it creates
the first sheet and gives me an error when it is time to filter for
the second criteria (I put stars on the line(s) it gives me error when
I use F8 to go line by line).
My sheet looks like this: row 10 has my headers and column D and ...
have my data.

A B C D
11 123 1065
12 -------------------------------- 1065
13 -------------------------------- 1065
14 -------------------------------- 1065
15 -------------------------------- 1065
16 1070
17 --------------------------------- 1070
18 --------------------------------- 1070
19 --------------------------------- 1070

It will continue with 1080, 1090 (each one has differnet # of rows).

Here is the macro:

Sub Copy_With_AutoFilter1()
Dim WSNew As Worksheet
Dim rng2 As Range
Dim j As String
Dim i As Integer


With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Firstly, remove the AutoFilter
ThisWorkbook.Sheets("sheet1").AutoFilterMode = False

' Filter Row10 which has my headings:
ThisWorkbook.Sheets("sheet1").Rows("10:10").Select
Selection.AutoFilter

'Delete the sheet MyFilterResult if it exists
'On Error Resume Next
'Application.DisplayAlerts = False
'Sheets("MyFilterResult").Delete
'Application.DisplayAlerts = True
'On Error GoTo 0


'starts from row 10:
For i = 10 To
ThisWorkbook.Sheets("Sheet1").Range("C11:C250").Ro ws.Count
If ThisWorkbook.Sheets("sheet1").Range("B" & i).Text < "" Then

' set the criteria
****** j = ThisWorkbook.Sheets("sheet1").Range("B" &
i).Text
******ThisWorkbook.Sheets("sheet1").Range("b10").S elect
Selection.AutoFilter Field:=3, Criteria1:="=" & j


'Add a new worksheet to copy the filter results in
Set WSNew = Worksheets.Add
WSNew.Name = j

'Copy the visible data and use PasteSpecial to paste to the new
worksheet
ThisWorkbook.Sheets("sheet1").AutoFilter.Range.Cop y
With WSNew.Range("A11")
' Paste:=8 will copy the columnwidth in Excel 2000 and higher
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With

' To remove the filter from Sheet1 before filtering for next
value:
ThisWorkbook.Sheets("sheet1").AutoFilterMode = False
End If
Next i

'Close AutoFilter
WS.AutoFilterMode = False

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub


Your help would be grately appreciated.
Thanks.

nbeizaie