Excel VBA - Autofilter, copy, paste to new sheet

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

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
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:

Incident Ticket #Change Ticket #Build SummaryBuilderActionINI RecordINI IDD/C Adv Opt Item #Record NameClinic(s)SpecialtyBLD DateBLD ValidatorSTG DateSTG Data CourierSTG ValidatorMST DateREF DatePRD DatePRD Data CourierPRD ValidatorCommentsIssue IDItem Type
35638124926Modified immunization and added Do not requireLEVY, REIDMODIFIEDEAP - PROCEDURE280208880TD VACCINE PRESERVATIVE FREE =>7YO IMALLALL6/5/2013 6/5/2013BERRY, JOANMUELLER, CHARISSA6/5/2013 6/5/2013BERRY, JOANMUELLER, CHARISSA 1Item
35638124926Modified immunization and added Do not requireLEVY, REIDMODIFIEDEAP - PROCEDURE280198880ROTAVIRUS VACCINE PENTAVALENT 3 DOSE ORALALLALL6/5/2013 6/5/2013BERRY, JOANMUELLER, CHARISSA6/5/2013 6/5/2013BERRY, JOANMUELLER, CHARISSA 2Item
35638124926Modified immunization and added Do not requireLEVY, REIDMODIFIEDEAP - PROCEDURE280150880HIB PRP-OMP CONJUGATE VACCINE 3 DOSE IMALLALL6/5/2013 6/5/2013BERRY, JOANMUELLER, CHARISSA6/5/2013 6/5/2013BERRY, JOANMUELLER, CHARISSA 3Item
23286824777Change setting for Dual Mode Ordering Default to "Outpatient"MUELLER, CHARISSAMODIFIEDDEP - DEPARTMENT2660217530GME FAMILY MED AT MHCD 4/25/2013 6/6/2013BERRY, JOANMUELLER, CHARISSA 6/6/2013BERRY, JOANMUELLER, CHARISSA 4Item
35666924964Update follow up with correct encounter report PAGE, ANNAMODIFIEDLPR - EPICCARE PROFILES40000010007EH SYSTEM DEFALLALL6/6/2013 6/6/2013FRAZZINI, MICHAELCUSHMAN, SEE 6/6/2013FRAZZINI, MICHAELCUSHMAN, SEE 5Item
35666924964add charge print groups to encounter reportPAGE, ANNAMODIFIEDLRP - REPORTS2103000102500HN VISIT SUMMARY: ANTICOAGULATION CHECKALLALL6/6/2013 6/6/2013FRAZZINI, MICHAELCUSHMAN, SEE 6/6/2013FRAZZINI, MICHAELCUSHMAN, SEE 6Item
35666924964add charge print groups to encounter reportPAGE, ANNAMODIFIEDLRP - REPORTS20151111500EH AMB VISIT SUMMARY:W/O HISTORYALLALL6/6/2013 6/6/2013FRAZZINI, MICHAELCUSHMAN, SEE 6/6/2013FRAZZINI, MICHAELCUSHMAN, SEE 7Item
24949update LPF with Lab OrdersSAYRE, CATHERINEMODIFIEDLPF - PREFERENCE LISTS210312038 HN MT SVB LAB FACILITY 6/6/2013 6/6/2013SAYRE, CATHERINEBERRY, JOAN 6/6/2013BERRY, JOANSAYRE, CATHERINE 9Item
24963update LPF with Lab OrdersSAYRE, CATHERINEMODIFIEDLPF - PREFERENCE LISTS210311974 HN MT HRH LAB FACILITY 6/6/2001 6/6/2013SAYRE, CATHERINEBERRY, JOAN 6/6/2013FIMBREZ, JIMSAYRE, CATHERINE 10Item
317375 Added department to LWS recordWEST, JEFFREYMODIFIEDLWS - WORKSTATION REGISTRY26264manualMPF051 6/3/2013 6/3/2013 WEST, JEFFREY 11Item
317375 Added department to LWS recordWEST, JEFFREYMODIFIEDLWS - WORKSTATION REGISTRY26265manualMFP052 6/3/2013 6/3/2013 WEST, JEFFREY 12Item
317375 Added department to LWS recordWEST, JEFFREYMODIFIEDLWS - WORKSTATION REGISTRY26266manualMFP053 6/3/2013 6/3/2013 WEST, JEFFREY 13Item
357317, 356691, 35774324985update LPF with Lab OrdersSAYRE, CATHERINEMODIFIEDLPF - PREFERENCE LISTS210312041 HN CO SMG LAB FACILITY PREF LISTSAINT MARY - GRAND JUNCTION, CO 6/6/2013 6/6/2013SAYRE, CATHERINEKLEPFER, DENISE 6/6/2013FRAZZINI, MICHAELKLEPFER, DENISE 14Item
24987Change setting to "Never require" for NDC requirement behaviorMUELLER, CHARISSAMODIFIEDDEP - DEPARTMENT5100117590SVPN ABSAROKEE MED CL 6/6/2013 6/6/2013BERRY, JOANMUELLER, CHARISSA 6/6/2013BERRY, JOANMUELLER, CHARISSA 15Item
24987Change setting to "Never require" for NDC requirement behaviorMUELLER, CHARISSAMODIFIEDDEP - DEPARTMENT5100617590SVPN LONG TERM CARE 6/6/2013 6/6/2013BERRY, JOANMUELLER, CHARISSA 6/6/2013BERRY, JOANMUELLER, CHARISSA 16Item

<tbody>
</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>

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
I believe

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

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

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

Forum statistics

Threads
1,213,536
Messages
6,114,202
Members
448,554
Latest member
Gleisner2

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