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

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

hi shabutt

See
http://www.rondebruin.nl/copy5.htm


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"shabutt" <(E-Mail Removed)> wrote in message news:C23273F3-72E2-480E-BE77-(E-Mail Removed)...
> 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

Hi Joel,

Thank you for your time and help. Your code misses a few points I mentioned
in my earlier post.

1- I want separate sheet(s) for each filter value, i.e., one sheet for one
filter value, two sheets for two filter values and so on.

2- The sheet(s) should be named on filter value(s).

Another request for you: How could the first row (column labels) be copied
with the filtered data.

Regards.


"Joel" wrote:

> 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