Test this one Josh

Sub Copy_With_AutoFilter2()
Dim WS As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim Str As String

Set WS = Sheets("sheet1") '<<< Change
'A1 is the top left cell of your filter range and the header of the first column
Set rng = WS.Range("A1").CurrentRegion '<<< Change
Str = "*infro411.com*" '<<< Change

'Close AutoFilter first
WS.AutoFilterMode = False

'This example filter on the first column in the range (change the field if needed)
rng.AutoFilter Field:=1, Criteria1:=Str

Set WSNew = Worksheets.Add
WS.AutoFilter.Range.Copy
With WSNew.Range("A1")
' Paste:=8 will copy the columnwidth in Excel 2000 and higher
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With

With WS.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then
rng2.EntireRow.Delete
End If
End With

WS.AutoFilterMode = False

End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl



"jhahes" wrote in message
...

Thank you Ron for the code....It worked great, however,

is there anyway it can delete the row that it copies from....on Sheet1


thanks

Josh


--
jhahes
------------------------------------------------------------------------
jhahes's Profile: http://www.excelforum.com/member.php...o&userid=23596
View this thread: http://www.excelforum.com/showthread...hreadid=569172