Snasui Excel Forum

Code: Select all

 Sub nnn()
Dim c As  Range
Dim  rng As Range
Dim  LR As Integer
 LR = Cells(Rows.Count, "a").End(xlUp).Row
Set rng = Range("A1:AJ" & LR)
Range("C1:C" & LR).AdvancedFilter Action:=xlFilterCopy,CopyToRange:=Range("AM1"), Unique:=True    
For Each c In Range([AM2], Cells(Rows.Count, "AM").End(xlUp))
With  rng
.AutoFilter Field:=3,Criteria1:=c.Value
 .SpecialCells(xlCellTypeVisible).Copy              Sheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
 ActiveSheet.Paste
End With
Next
End Sub

Thanks

Code: Select all

'Other code
.SpecialCells(xlCellTypeVisible).Copy  Workbooks.add.workshets(1).range("a1")
activeworkbook.worksheets(1).name = c.value
'Other code