Excel VBA - Autofilter, copy, paste to new sheet

B

Benzoli7

Board Regular
Joined
Jan 11, 2010
Messages
136
Hello,

Can anyone help me with some code that can autofilter, copy, and paste to a new sheet that is named after the filtered field?

Row 1 has column headers and column A contains the unique values that I want to filter by. There will be multiple rows containing each unique value.

I don't know all of the unique values that could be in column A. Is there a way to write the code to make the macro filter each unique value without knowing what those values are?

I also need it to create a new sheet and name the sheet after the unique value from column A.

Next, it would need to copy the filtered data and paste it to the newly created sheet.

It would need to repeat this process until each unique data set has been copied to its own sheet.

Thanks for any help.
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
Sort by date Sort by votes
You can record a macro for the first filtered value, then post what you get back here for someone to set up dynamically for you.
 
Upvote 0
Here is the code that I recorded and edited.

I don't know all of the different values that could be used in Criteria 1.
The new sheet needs to be named after the value for Criteria 1.

I hope this helps. Let me know if you have any more questions.

Thanks

HTML: 
    Selection.AutoFilter
   
    ActiveSheet.Range("$A$1:$AJ$81142").AutoFilter Field:=5, Criteria1:= _
        "101 Transport Inc" 'This is the unique value that I don't know.
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "101 Transport Inc" 'The new sheet needs to be named after
    ActiveSheet.Paste                                                  ' unique value listed above
 
Upvote 0
See if this does it for you:

<font face=Calibri><SPAN style="color:#00007F">Sub</SPAN> Foo()<br>    <SPAN style="color:#00007F">Dim</SPAN> c <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> rng <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> LR <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>        <br>        LR = Cells(Rows.Count, "R").End(xlUp).Row<br>        <SPAN style="color:#00007F">Set</SPAN> rng = Range("A1:AJ" & LR)<br>        <br>        Range("E1:E" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AM1"), Unique:=<SPAN style="color:#00007F">True</SPAN><br>        <br>        <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> c <SPAN style="color:#00007F">In</SPAN> Range([AM2], Cells(Rows.Count, "AM").End(xlUp))<br>            <SPAN style="color:#00007F">With</SPAN> rng<br>                .AutoFilter<br>                .AutoFilter Field:=5, Criteria1:=c.Value<br>                .SpecialCells(xlCellTypeVisible).Copy<br>                Sheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value<br>                ActiveSheet.Paste<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        <SPAN style="color:#00007F">Next</SPAN> c<br>        <br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

HTH,
 
Upvote 0
I know this is an older thread. I'm doing something similiar to this, but when I copy this code into mine, I'm getting an error. My unique column is F which is called "INI Record" instead of A. This is how I modified the code to try and make it work for mine:

Code: 
Sub Foo()
    Dim c As Range
    Dim rng As Range
    Dim LR As Long
        
        LR = Cells(Rows.Count, "R").End(xlUp).Row
        Set rng = Range("F1:FJ" & LR)
        
        Range("F1:F" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AM1"), Unique:=True
        
        For Each c In Range([AM2], Cells(Rows.Count, "AM").End(xlUp))
            With rng
                .AutoFilter
                .AutoFilter Field:=5, Criteria1:=c.Value
                .SpecialCells(xlCellTypeVisible).Copy
                Sheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
                ActiveSheet.Paste
            End With
        Next c
        
End Sub

When I run the code, I get an error of "Run-time error '1004': Application-defined or object-defined error"

Here is a paste of a few rows of what my spreadsheet looks like:

[TABLE="class: grid, width: 4740"]
<tbody>[TR]
[TD]Incident Ticket #[/TD]
[TD]Change Ticket #[/TD]
[TD]Build Summary[/TD]
[TD]Builder[/TD]
[TD]Action[/TD]
[TD]INI Record[/TD]
[TD]INI ID[/TD]
[TD]D/C Adv Opt Item #[/TD]
[TD]Record Name[/TD]
[TD]Clinic(s)[/TD]
[TD]Specialty[/TD]
[TD]BLD Date[/TD]
[TD]BLD Validator[/TD]
[TD]STG Date[/TD]
[TD]STG Data Courier[/TD]
[TD]STG Validator[/TD]
[TD]MST Date[/TD]
[TD]REF Date[/TD]
[TD]PRD Date[/TD]
[TD]PRD Data Courier[/TD]
[TD]PRD Validator[/TD]
[TD]Comments[/TD]
[TD]Issue ID[/TD]
[TD]Item Type[/TD]
[/TR]
[TR]
[TD]356381[/TD]
[TD]24926[/TD]
[TD]Modified immunization and added Do not require[/TD]
[TD]LEVY, REID[/TD]
[TD]MODIFIED[/TD]
[TD]EAP - PROCEDURE[/TD]
[TD]280208[/TD]
[TD]880[/TD]
[TD]TD VACCINE PRESERVATIVE FREE =>7YO IM[/TD]
[TD]ALL[/TD]
[TD]ALL[/TD]
[TD="align: right"]6/5/2013[/TD]
[TD] [/TD]
[TD="align: right"]6/5/2013[/TD]
[TD]BERRY, JOAN[/TD]
[TD]MUELLER, CHARISSA[/TD]
[TD="align: right"]6/5/2013[/TD]
[TD] [/TD]
[TD="align: right"]6/5/2013[/TD]
[TD]BERRY, JOAN[/TD]
[TD]MUELLER, CHARISSA[/TD]
[TD] [/TD]
[TD]1[/TD]
[TD]Item[/TD]
[/TR]
[TR]
[TD]356381[/TD]
[TD]24926[/TD]
[TD]Modified immunization and added Do not require[/TD]
[TD]LEVY, REID[/TD]
[TD]MODIFIED[/TD]
[TD]EAP - PROCEDURE[/TD]
[TD]280198[/TD]
[TD]880[/TD]
[TD]ROTAVIRUS VACCINE PENTAVALENT 3 DOSE ORAL[/TD]
[TD]ALL[/TD]
[TD]ALL[/TD]
[TD="align: right"]6/5/2013[/TD]
[TD] [/TD]
[TD="align: right"]6/5/2013[/TD]
[TD]BERRY, JOAN[/TD]
[TD]MUELLER, CHARISSA[/TD]
[TD="align: right"]6/5/2013[/TD]
[TD] [/TD]
[TD="align: right"]6/5/2013[/TD]
[TD]BERRY, JOAN[/TD]
[TD]MUELLER, CHARISSA[/TD]
[TD] [/TD]
[TD]2[/TD]
[TD]Item[/TD]
[/TR]
[TR]
[TD]356381[/TD]
[TD]24926[/TD]
[TD]Modified immunization and added Do not require[/TD]
[TD]LEVY, REID[/TD]
[TD]MODIFIED[/TD]
[TD]EAP - PROCEDURE[/TD]
[TD]280150[/TD]
[TD]880[/TD]
[TD]HIB PRP-OMP CONJUGATE VACCINE 3 DOSE IM[/TD]
[TD]ALL[/TD]
[TD]ALL[/TD]
[TD="align: right"]6/5/2013[/TD]
[TD] [/TD]
[TD="align: right"]6/5/2013[/TD]
[TD]BERRY, JOAN[/TD]
[TD]MUELLER, CHARISSA[/TD]
[TD="align: right"]6/5/2013[/TD]
[TD] [/TD]
[TD="align: right"]6/5/2013[/TD]
[TD]BERRY, JOAN[/TD]
[TD]MUELLER, CHARISSA[/TD]
[TD] [/TD]
[TD]3[/TD]
[TD]Item[/TD]
[/TR]
[TR]
[TD]232868[/TD]
[TD]24777[/TD]
[TD]Change setting for Dual Mode Ordering Default to "Outpatient"[/TD]
[TD]MUELLER, CHARISSA[/TD]
[TD]MODIFIED[/TD]
[TD]DEP - DEPARTMENT[/TD]
[TD]26602[/TD]
[TD]17530[/TD]
[TD]GME FAMILY MED AT MHCD[/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]4/25/2013[/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD]BERRY, JOAN[/TD]
[TD]MUELLER, CHARISSA[/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD]BERRY, JOAN[/TD]
[TD]MUELLER, CHARISSA[/TD]
[TD] [/TD]
[TD]4[/TD]
[TD]Item[/TD]
[/TR]
[TR]
[TD]356669[/TD]
[TD]24964[/TD]
[TD]Update follow up with correct encounter report [/TD]
[TD]PAGE, ANNA[/TD]
[TD]MODIFIED[/TD]
[TD]LPR - EPICCARE PROFILES[/TD]
[TD]400000[/TD]
[TD]10007[/TD]
[TD]EH SYSTEM DEF[/TD]
[TD]ALL[/TD]
[TD]ALL[/TD]
[TD="align: right"]6/6/2013[/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD]FRAZZINI, MICHAEL[/TD]
[TD]CUSHMAN, SEE[/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD]FRAZZINI, MICHAEL[/TD]
[TD]CUSHMAN, SEE[/TD]
[TD] [/TD]
[TD]5[/TD]
[TD]Item[/TD]
[/TR]
[TR]
[TD]356669[/TD]
[TD]24964[/TD]
[TD]add charge print groups to encounter report[/TD]
[TD]PAGE, ANNA[/TD]
[TD]MODIFIED[/TD]
[TD]LRP - REPORTS[/TD]
[TD]2103000102[/TD]
[TD]500[/TD]
[TD]HN VISIT SUMMARY: ANTICOAGULATION CHECK[/TD]
[TD]ALL[/TD]
[TD]ALL[/TD]
[TD="align: right"]6/6/2013[/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD]FRAZZINI, MICHAEL[/TD]
[TD]CUSHMAN, SEE[/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD]FRAZZINI, MICHAEL[/TD]
[TD]CUSHMAN, SEE[/TD]
[TD] [/TD]
[TD]6[/TD]
[TD]Item[/TD]
[/TR]
[TR]
[TD]356669[/TD]
[TD]24964[/TD]
[TD]add charge print groups to encounter report[/TD]
[TD]PAGE, ANNA[/TD]
[TD]MODIFIED[/TD]
[TD]LRP - REPORTS[/TD]
[TD]20151111[/TD]
[TD]500[/TD]
[TD]EH AMB VISIT SUMMARY:W/O HISTORY[/TD]
[TD]ALL[/TD]
[TD]ALL[/TD]
[TD="align: right"]6/6/2013[/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD]FRAZZINI, MICHAEL[/TD]
[TD]CUSHMAN, SEE[/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD]FRAZZINI, MICHAEL[/TD]
[TD]CUSHMAN, SEE[/TD]
[TD] [/TD]
[TD]7[/TD]
[TD]Item[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD]24949[/TD]
[TD]update LPF with Lab Orders[/TD]
[TD]SAYRE, CATHERINE[/TD]
[TD]MODIFIED[/TD]
[TD]LPF - PREFERENCE LISTS[/TD]
[TD]210312038[/TD]
[TD] [/TD]
[TD]HN MT SVB LAB FACILITY[/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD]SAYRE, CATHERINE[/TD]
[TD]BERRY, JOAN[/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD]BERRY, JOAN[/TD]
[TD]SAYRE, CATHERINE[/TD]
[TD] [/TD]
[TD]9[/TD]
[TD]Item[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD]24963[/TD]
[TD]update LPF with Lab Orders[/TD]
[TD]SAYRE, CATHERINE[/TD]
[TD]MODIFIED[/TD]
[TD]LPF - PREFERENCE LISTS[/TD]
[TD]210311974[/TD]
[TD] [/TD]
[TD]HN MT HRH LAB FACILITY[/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]6/6/2001[/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD]SAYRE, CATHERINE[/TD]
[TD]BERRY, JOAN[/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD]FIMBREZ, JIM[/TD]
[TD]SAYRE, CATHERINE[/TD]
[TD] [/TD]
[TD]10[/TD]
[TD]Item[/TD]
[/TR]
[TR]
[TD]317375[/TD]
[TD] [/TD]
[TD]Added department to LWS record[/TD]
[TD]WEST, JEFFREY[/TD]
[TD]MODIFIED[/TD]
[TD]LWS - WORKSTATION REGISTRY[/TD]
[TD]26264[/TD]
[TD]manual[/TD]
[TD]MPF051[/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]6/3/2013[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]6/3/2013[/TD]
[TD] [/TD]
[TD]WEST, JEFFREY[/TD]
[TD] [/TD]
[TD]11[/TD]
[TD]Item[/TD]
[/TR]
[TR]
[TD]317375[/TD]
[TD] [/TD]
[TD]Added department to LWS record[/TD]
[TD]WEST, JEFFREY[/TD]
[TD]MODIFIED[/TD]
[TD]LWS - WORKSTATION REGISTRY[/TD]
[TD]26265[/TD]
[TD]manual[/TD]
[TD]MFP052[/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]6/3/2013[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]6/3/2013[/TD]
[TD] [/TD]
[TD]WEST, JEFFREY[/TD]
[TD] [/TD]
[TD]12[/TD]
[TD]Item[/TD]
[/TR]
[TR]
[TD]317375[/TD]
[TD] [/TD]
[TD]Added department to LWS record[/TD]
[TD]WEST, JEFFREY[/TD]
[TD]MODIFIED[/TD]
[TD]LWS - WORKSTATION REGISTRY[/TD]
[TD]26266[/TD]
[TD]manual[/TD]
[TD]MFP053[/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]6/3/2013[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]6/3/2013[/TD]
[TD] [/TD]
[TD]WEST, JEFFREY[/TD]
[TD] [/TD]
[TD]13[/TD]
[TD]Item[/TD]
[/TR]
[TR]
[TD]357317, 356691, 357743[/TD]
[TD]24985[/TD]
[TD]update LPF with Lab Orders[/TD]
[TD]SAYRE, CATHERINE[/TD]
[TD]MODIFIED[/TD]
[TD]LPF - PREFERENCE LISTS[/TD]
[TD]210312041[/TD]
[TD] [/TD]
[TD]HN CO SMG LAB FACILITY PREF LIST[/TD]
[TD]SAINT MARY - GRAND JUNCTION, CO[/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD]SAYRE, CATHERINE[/TD]
[TD]KLEPFER, DENISE[/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD]FRAZZINI, MICHAEL[/TD]
[TD]KLEPFER, DENISE[/TD]
[TD] [/TD]
[TD]14[/TD]
[TD]Item[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD]24987[/TD]
[TD]Change setting to "Never require" for NDC requirement behavior[/TD]
[TD]MUELLER, CHARISSA[/TD]
[TD]MODIFIED[/TD]
[TD]DEP - DEPARTMENT[/TD]
[TD]51001[/TD]
[TD]17590[/TD]
[TD]SVPN ABSAROKEE MED CL[/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD]BERRY, JOAN[/TD]
[TD]MUELLER, CHARISSA[/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD]BERRY, JOAN[/TD]
[TD]MUELLER, CHARISSA[/TD]
[TD] [/TD]
[TD]15[/TD]
[TD]Item[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD]24987[/TD]
[TD]Change setting to "Never require" for NDC requirement behavior[/TD]
[TD]MUELLER, CHARISSA[/TD]
[TD]MODIFIED[/TD]
[TD]DEP - DEPARTMENT[/TD]
[TD]51006[/TD]
[TD]17590[/TD]
[TD]SVPN LONG TERM CARE[/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD]BERRY, JOAN[/TD]
[TD]MUELLER, CHARISSA[/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]6/6/2013[/TD]
[TD]BERRY, JOAN[/TD]
[TD]MUELLER, CHARISSA[/TD]
[TD] [/TD]
[TD]16[/TD]
[TD]Item[/TD]
[/TR]
</tbody><colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col span="2"><col><col><col><col span="2"><col><col><col></colgroup>[/TABLE]

Any help will be greatly appreciated.

Michael M.
 
Upvote 0
It's erroring on
Range("F1:F" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AM1"), Unique:=True
Click to expand...
I believe

I did the Step into and that is the line that it stopped at.
 
Upvote 0
mtmazar said:
It's erroring on I believe

I did the Step into and that is the line that it stopped at.
Click to expand...

Sorry I didn't see this earlier. Take a look at your LR declaration, then your data -column R has no data, so the LR variable is set as 1. You need to pick a column that will always have data in it.
 
Upvote 0
You must log in or register to reply here.

Similar threads

V
  • Solved
Need VBA to split data into multiple sheets paste formulas, formatting AND data validation
Replies
2
Views
69
vanessavalentino83
V
R
  • Solved
Excel VBA to filter by unique value, copy paste into new workbook and save
Replies
2
Views
846
rittersportyummy
R
I
  • Question Question
Filter column on text value if that value exists using VBA
Replies
7
Views
367
Peter_SSs
Peter_SSs
W
  • Question Question
Macro/VBA code code for creating new excel file for each pivot table from a column filter
Replies
1
Views
472
Anthony47
A
S
  • Question Question
Can’t hide column using VBA
Replies
3
Views
283
Joe4
Joe4

Forum statistics

Threads
1,224,395
Messages
6,178,355
Members
452,841
Latest member
GenAkaman

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top