Excel VBA : Filtering and copy pasting to new sheet

638 views
Skip to first unread message

Gehani, Deepak

unread,
Apr 22, 2015, 2:07:37 PM4/22/15
to xlvb...@googlegroups.com

Suppose you are asked to apply filter on a column and paste result of a filter into a new worksheet and renaming worksheet with the filter value. This needs to be done for each unique values in a column in which we have applied filter. It is a very time consuming process if you do it manually. It can be easily done with Excel VBA programming.

The sample data is shown below :

http://2.bp.blogspot.com/-njY2lvLXwUM/VTNt8cizW_I/AAAAAAAADok/ND1q_FE7C0c/s1600/sample%2Bdata.png

 

In the following VBA code, a filter is applied on column F (Rank).


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

'specify sheet name in which the data is stored
sht = "DATA Sheet"

'change filter column in the following code
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

' Turn off filter
Sheets(sht).AutoFilterMode = False

With Application
.CutCopyMode = False
.ScreenUpdating = True
End With

End Sub

 

 

Thanks

 

Deepak Gehani | Quality Specialist

BPQM E&I Appeals & Grievances Quality

(Office e-mail) deepak_...@optum.com | (Cell) +91-9711276666

www.optum.com

 

 

 


This e-mail, including attachments, may include confidential and/or
proprietary information, and may be used only by the person or entity
to which it is addressed. If the reader of this e-mail is not the intended
recipient or his or her authorized agent, the reader is hereby notified
that any dissemination, distribution or copying of this e-mail is
prohibited. If you have received this e-mail in error, please notify the
sender by replying to this message and delete this e-mail immediately.

Rajguru Sahani

unread,
Apr 23, 2015, 3:00:12 AM4/23/15
to xlvb...@googlegroups.com

Deepak this is too good.....

Regards
Raj

--
You received this message because you are subscribed to the Google Groups "xlvba.eyes" group.
To unsubscribe from this group and stop receiving emails from it, send an email to xlvbaeyes+...@googlegroups.com.
Visit this group at http://groups.google.com/group/xlvbaeyes.
To view this discussion on the web visit https://groups.google.com/d/msgid/xlvbaeyes/2E89A4F9C57113408EE39A8D6276B18D1813CB%40APSWP0835.ms.ds.uhc.com.
For more options, visit https://groups.google.com/d/optout.
Reply all
Reply to author
Forward
0 new messages