Sub CopyFilter()
'by Tom Ogilvy
Dim rng As Range
Dim rng2 As Range

Set OldSht = ActiveSheet
With OldSht.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
FilterValue = rng2(0)
On Error GoTo 0


End With
If rng2 Is Nothing Then
MsgBox "No data to copy"
Else
Sheets.Add after:=Sheets(Sheets.Count)
Set NewSht = ActiveSheet
NewSht.Name = FilterValue
Set rng = OldSht.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
Destination:=NewSht.Range("A1")
End If
OldSht.ShowAllData
End Sub

"shabutt" wrote:

Hi to everyone,

The copyfilter code (copies the filtered rows from the active sheet to
another sheet) works perfectly for my data. But I would like to modify one
thing in it but could not do it with my limited vba knowledge and would like
your help.

This code doesn't create sheet(s) automatically for filtered criteria. But I
want the code to create the sheet(s) as per filter criteria(s) and copy the
filtered rows in it.

Here is the code from www.contextures.com/xlautofilter03.html

Sub CopyFilter()
'by Tom Ogilvy
Dim rng As Range
Dim rng2 As Range

With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If rng2 Is Nothing Then
MsgBox "No data to copy"
Else
Worksheets("Sheet2").Cells.Clear
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("Sheet2").Range("A1")
End If
ActiveSheet.ShowAllData
End Sub

Please guide me.

Regrads