Shazam
02-08-2007, 01:05 PM
Hi everyone,
I'm trying to do a advance Filter to look through multiple worksheets and copy the uniques into a summary sheet. I have this so far.
Sub sortandmove()
Dim Rng As Range
Dim i As Variant
Dim wSht As Worksheet
Application.ScreenUpdating = False
Sheet5.Range("A2:A5000").ClearContents
For Each wSht In ThisWorkbook.Worksheets
If wSht.Name <> "Final List" Then
'wSht.Activate
wSht.Range("A1:B2000").AutoFilter field:=1, Criteria1:="<>"
wSht.Range("A2:B2000").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("Final List").Range("A65536").End(xlUp).Offset(1, 0)
wSht.AutoFilterMode = False
End If
Next wSht
Application.ScreenUpdating = True
End Sub
I tried to add this , Unique:=True in line below but it does not work.
wSht.Range("A2:B2000").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("Final List").Range("A65536").End(xlUp).Offset(1, 0), Unique:=True
I'm trying to do a advance Filter to look through multiple worksheets and copy the uniques into a summary sheet. I have this so far.
Sub sortandmove()
Dim Rng As Range
Dim i As Variant
Dim wSht As Worksheet
Application.ScreenUpdating = False
Sheet5.Range("A2:A5000").ClearContents
For Each wSht In ThisWorkbook.Worksheets
If wSht.Name <> "Final List" Then
'wSht.Activate
wSht.Range("A1:B2000").AutoFilter field:=1, Criteria1:="<>"
wSht.Range("A2:B2000").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("Final List").Range("A65536").End(xlUp).Offset(1, 0)
wSht.AutoFilterMode = False
End If
Next wSht
Application.ScreenUpdating = True
End Sub
I tried to add this , Unique:=True in line below but it does not work.
wSht.Range("A2:B2000").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("Final List").Range("A65536").End(xlUp).Offset(1, 0), Unique:=True