run macro on AutoFilter and show data in new sheet

Question

Actually what i want to do , i have following data With Auto Filtering ,

enter image description here

-> I want to create new sheet for each unique Name selected from filtering .i.e. if John and Alex are selected then 2 new sheets should be created one for John and second for Alex , and each of them show own data (Name + No + R). When Next time if master sheet get updated then news data should be appended when i run macro. i'm using following code but its not working 100%.

Sub mycar()
   x = 2
   Do While Cells(x, 1) <> ""
   If Cells(x, 1) = "John" Then
   Worksheets("Sheet1").Rows(x).Copy
   Worksheets("Sheet2").Activate
   eRow = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
   ActiveSheet.Paste Destination:=Worksheets("Sheet2").Rows(eRow)
   End If
   Worksheets("Sheet1").Activate
   x = x + 1
   Loop
End Sub

-> Here it copy only single data Written in the quotes.

-> Second time if i run this code , it is appending same data again with new data.

Help me to avoid this mistakes.

Thank you.

This would get you on the right track.. http://stackoverflow.com/questions/11631363/how-to-copy-a-line-in-excel-using-a-specific-word-and-pasting-to-another-excel-s — Siddharth Rout, Apr 03 '13 at 18:24
Siddharth thanks for your kind help but actually i want to run macro on auto filter. — Ronak Mehta, Apr 04 '13 at 16:08
Is it ok for you if you clear Sheet1 and Sheet2 each time you run your macro?? Just before you copy rows there?? Then each time you have complete set of data... — Kazimierz Jawor, Apr 04 '13 at 16:43

Kazimierz Jawor · Accepted Answer · 2013-04-04T18:50:32.093

As discussed there is other possibility to set filter parameters in Array in procedure. The code would look like this one:

Sub Solution()

Dim shData As Worksheet
    Set shData = Sheets("Arkusz1")    'or other reference to data sheet
Dim shNew As Worksheet
    shData.Activate
'get unique values based on Excel features
Range("a1").AutoFilter

Dim myArr As Variant
    myArr = Array("John", "max")

Range("a1").AutoFilter

Dim i As Long
For i = 0 To UBound(myArr)
    shData.Range("$A$1").AutoFilter Field:=1, Criteria1:=myArr(i), _
        Operator:=xlAnd
On Error Resume Next
    Sheets(myArr(i)).Range("A1").CurrentRegion.ClearContents

If Err.Number = 0 Then
    Range("A1").CurrentRegion.Copy Sheets(myArr(i)).Range("A1")
Else
    Set shNew = Sheets.Add(After:=Sheets(Sheets.Count))
    shData.Range("A1").CurrentRegion.Copy shNew.Range("A1")
    shNew.Name = myArr(i)
    Err.Clear
End If

Next i
'removing filter in master sheet
shData.Range("a1").AutoFilter

End Sub

score 0 · Answer 2 · answered Apr 03 '13 at 19:30

0

Substitute Worksheets("Sheet1").Rows(x).Copy by Worksheets("Sheet1").Rows(x).EntireRow.Copy

And clear the destination worksheet before adding information.

answered Apr 03 '13 at 19:30

Daniel Möller

84,878
18
192
214

`I want to create new sheet for each unique Name selected from filtering .i.e. if John and Alex are selected then 2 new sheets should be created one for John and second for Alex` Your code seems to do nothing like what he is asking – user2140261 Apr 03 '13 at 22:05

Kazimierz Jawor · Answer 3 · 2013-04-03T20:13:44.900

I do quite similar exercise quite often. Therefore I provide full possible solution with some comments inside the code. It works for all unique values in column A and creates (if not exists) sheet with appropriate name equals to filter parameters.

Sub Solution()
Dim shData As Worksheet
    Set shData = Sheets("Arkusz1")    'or other reference to data sheet
Dim shNew As Worksheet

'get unique values based on Excel features
'i guess some will not like it but I do :)
Range("a1").AutoFilter
Range("A1").CurrentRegion.Columns(1).Copy Range("ww1")
Range("ww1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
'be sure that range where you copy (like ww1) is empty range around 

Dim myArr As Variant
    myArr = Range(Range("ww2"), Range("ww2").End(xlDown))
Range("ww1").CurrentRegion.ClearContents     'some cleaning
Range("a1").AutoFilter '

Dim i As Long
For i = 1 To UBound(myArr, 1)
    ActiveSheet.Range("$A$1").AutoFilter Field:=1, Criteria1:=myArr(i, 1), _
        Operator:=xlAnd
On Error Resume Next
    'this is for two reason- to check if appropriate sheet exists, if so to clean top area
    'if you need to append you would comment this line
    Sheets(myArr(i, 1)).Range("A1").CurrentRegion.ClearContents

If Err.Number = 0 Then
    'if you need to append only you would need to set range-to-copy a bit different
    Range("A1").CurrentRegion.Copy Sheets(myArr(i, 1)).Range("A1")
Else
    Set shNew = Sheets.Add(After:=Sheets(Sheets.Count))
    shData.Range("A1").CurrentRegion.Copy shNew.Range("A1")
    shNew.Name = myArr(i, 1)
    Err.Clear
End If

Next i

End Sub

This could not fully meet your requirements but could be a complete solution to improve accordingly.

thanks for your kind help but actually i want to run macro on auto filter. — Ronak Mehta, Apr 04 '13 at 16:13
you mean that: 1st step you check some names with auto filter, 2nd step run the macro, 3rd- macro creates sheets for each name?? — Kazimierz Jawor, Apr 04 '13 at 16:19
No dude i have master sheet , macro should be run when i complete selection from AutoFilter , in auto filter if i select John and Max it should copy each of them data from master sheet to new sheet (Sheet2 , Sheet3) — Ronak Mehta, Apr 04 '13 at 16:31
ok, that is what I mean (sorry for poor English)... So, if you have a lot of data than my 'filtering' solution will be quick. It would require some changes before looping in the code I proposed. See also some comment under your question. — Kazimierz Jawor, Apr 04 '13 at 16:41
`ShData` is a sheet where you have batch of your data to autofilter. — Kazimierz Jawor, Apr 04 '13 at 17:35
let us [continue this discussion in chat](http://chat.stackoverflow.com/rooms/27574/discussion-between-ronakmehta-and-kazjaw) — Ronak Mehta, Apr 04 '13 at 17:36

score 0 · Answer 4 · answered Apr 07 '13 at 04:37

Heading ##Below code is as per your requirement. Modify it based upon your requirement.

Private Sub Worksheet_Calculate()
  Dim x As Integer
  Dim rnge As Integer
  x = Range(Selection, Selection.End(xlDown)).Count
  rnge = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Rows.Count

  If Range("E1").Value > rnge Then
   Range("A1").Select
   Range(Selection, Selection.End(xlToRight)).Select
   Range(Selection, Selection.End(xlDown)).Select
   Selection.Copy
   Sheets(2).Select
   ActiveSheet.Paste
  End If
End Sub

Hi Ronik Mehta..you have to modify the above code based upon your requirement. — Vishwas - xCELL Solutions, Apr 07 '13 at 04:38

run macro on AutoFilter and show data in new sheet

4 Answers4

Heading ##Below code is as per your requirement. Modify it based upon your requirement.