Copy with Advance Filter

[Edgar]

Hi

I am using Ron De Bruins excelent example of copy with
advanced filter (code below) but am having trouble
changing the line:
Set WSNew = Sheets.Add
So that it adds worksheets after the worksheet.count

I have tried

Set WSNew = Sheets.Add After:= sheets(sheets.Count)

but this doesnt work, any ideas?


Sub Copy_With_AdvancedFilter()
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long

'set range
Worksheets("Crystal_Table").Select
lastrow = ActiveSheet.Cells(Rows.Count, "A").End
(xlUp).Row
Set rang = Range(Cells(2, 1), Cells(lastrow, 8))

Set ws1 = Sheets("Crystal_Table")
Set rng = rang 'ws1.Range("Crystal_Table")

'Use a Dynamic range name,
http://www.contextures.com/xlNames01.html#Dynamic
'This example filter on the first column in the range
(change this if needed)

With ws1
rng.Columns(2).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
'You see that the last two columns of the
worksheet are used to make a Unique list
'and add the CriteriaRange.(you can't use this
macro if you use this columns)
Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value

Set WSNew = Sheets.Add After:= sheets
(sheets.Count)
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number > 0 Then
MsgBox "Change the name of : " &
WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0

rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range
("IU1:IU2"), _
CopyToRange:=WSNew.Range
("A1"), _
Unique:=False
Next
.Columns("IU:IV").Clear
End With
End Sub

 

[Ron de Bruin]

Hi Edgar

Use this

Set WSNew = Sheets.Add(After:=Sheets(Sheets.Count))

I am using Ron De Bruins excelent example

Most thing I steal from Debra Dalgleish<g>