• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Help..Vba-Filter and Paste Unique Values to New Sheets

Hello All,

I need help here.... I have a set of data where I filter a criteria and copy paste in different sheets of the same work book.

Now the challenge is :
If you run the macro more than once, the error would occur as sheets already exist. Is there any workaround

where in I need to delete all the created sheets created by the macro and then re run the code again.

Code:
Sub filter()
Application.ScreenUpdating = False
Dim x As Range
Dim rng As Range
Dim last As Long
Dim sht As String
Dim wS As Worksheet

sht = "DATA Sheet"


last = Sheets(sht).Cells(Rows.Count, "F").End(xlUp).Row
Set rng = Sheets(sht).Range("A1:F" & last)

Sheets(sht).Range("F1:F" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True


For Each x In Range([AA2], Cells(Rows.Count, "AA").End(xlUp))



With rng
.AutoFilter
.AutoFilter Field:=6, Criteria1:=x.Value
.SpecialCells(xlCellTypeVisible).Copy

Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
ActiveSheet.Paste
End With
Next x


Sheets(sht).AutoFilterMode = False

With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
Appreciate your assistance here. Attached worked file for your reference.
 

Attachments

Back
Top