VBA to Copy and Paste Rows if Conditions are Met

L

lpw0806

New Member
Joined
Jun 14, 2018
Messages
38
Hi -

I am a first time poster on this site. I am still pretty green to VBA, but am learning and have made some small / short macros. I am familiar with SQL if that helps at all.

Right now I have a file with a "Raw Data" tab. I'd like to have a macro that states something like "IF Column A = "75" and Column B = "West" and Column C = "Local" etc etc then:

1) Create a new sheet titled 75
2) Paste that data into this new sheet.
--- note: Ideally I'd like to copy a handful of columns on the Raw Data tab instead of all of them.

I think there will need to be a "loop" involved here? Also - the number of rows is not sedentary and will always change.

Thanks in advance for the help on this!!! Much appreciated!
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Sort by date Sort by votes
Hi & welcome to MrExcel
How about
Code: 
Sub FilterCopy()
   
   With Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
      If .AutoFilterMode Then .AutoFilterMode = False
      With .Range("[COLOR=#0000ff]A1:Z1[/COLOR]")
         .AutoFilter 1, 75
         .AutoFilter 2, "West"
         .AutoFilter 3, "Local"
      End With
      Sheets.Add(, Sheets(Sheets.Count)).Name = "75"
      .AutoFilter.Range.Copy Sheets("75").Range("A1")
      .AutoFilterMode = False
   End With
End Sub
Change sheet name in red & range in blue to suit.
 
Upvote 0
Omg!!! That really helped!! Thank you!! A few follow up questions:


  • Do these numbers (AutoFilter 1, AutoFilter 2, etc) reference the column that is being filtered? EX - AutoFilter 1 = Column A and AutoFilter 26 = Column Z?
.AutoFilter 1, 75
.AutoFilter 2, "West"
.AutoFilter 3, "Local"


  • Is there a way to only copy and paste certain columns? EX - only columns B, F, G, L-O


  • Is there a way to "loop" through the raw data to do multiple searches?
    • EX - First search (what you already showed me) looks for "75", "West" and "Local" and pastes those values into a new sheet
    • Then the macro would search for values with a different criteria (ex "50", "West" and "Local") - then a third search ("75", "West" and "National"), a fourth ("50", "West" and "National") etc etc

Thank you again for all of the help!! This was great!
 
Upvote 0
Do these numbers (AutoFilter 1, AutoFilter 2, etc) reference the column that is being filtered? EX - AutoFilter 1 = Column A and AutoFilter 26 = Column Z?
Click to expand...
Yes they do, as long as the autofilter starts in Col A.
You can create an array for the filter criteria like
Code: 
Sub FilterCopy()
   Dim ary As Variant
   ary = Array(75, "West", "Local", 50, "West", "local", 75, "West", "National")
   
   For i = 0 To UBound(ary) Step 3
      With Sheets("Sheet1")
         If .AutoFilterMode Then .AutoFilterMode = False
         With .Range("A1:Z1")
            .AutoFilter 1, ary(i)
            .AutoFilter 2, ary(i + 1)
            .AutoFilter 3, ary(i + 2)
         End With
         Sheets.Add(, Sheets(Sheets.Count)).name = "75"
         Intersect(.AutoFilter.Range, Range("B:B,F:G,L:O")).Copy Sheets("75").Range("A1")
         .AutoFilterMode = False
      End With
   Next i
End Sub
But what would the sheet names be?
 
Upvote 0
So both 75, "West", "Local" and 75, "West", "National" would both go on sheet name 75.
Is that right?
 
Upvote 0
ahhh....good point. I was just using those fields as a sample but realize now that it's a little confusing - sorry about that

Here is a sample of the data. I'd like the macro to search the data and output tabs ( named 50, 75, 85, 95, 100) - but not include all of the columns listed.

Criteria

  • Opportunity Owner: Department = National, Probability (%) = 50
  • Opportunity Owner: Department = National, Probability (%) = 75
  • Opportunity Owner: Department = National, Probability (%) = 85
  • Opportunity Owner: Department = National, Probability (%) = 95
  • Opportunity Owner: Department = National, Probability (%) = 100

Columns to Include


  • Opportunity Owner
  • Account Name
  • Opportunity Name
  • Probability (%)
  • Previous Probability
  • Last Change Date
  • Duration Date
  • SP
  • DI
  • Total

[TABLE="width: 2654"]
<colgroup><col><col><col><col><col><col span="2"><col><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]Opportunity ID[/TD]
[TD]Opportunity Owner[/TD]
[TD]Opportunity Owner: Department[/TD]
[TD]Probability (%)[/TD]
[TD]Previous Probability[/TD]
[TD]Account Name[/TD]
[TD]Opportunity Name[/TD]
[TD]Client Category[/TD]
[TD]Type[/TD]
[TD]Last Change Date[/TD]
[TD]Duration Days[/TD]
[TD]RV[/TD]
[TD]SP[/TD]
[TD]DI[/TD]
[TD]Total[/TD]
[/TR]
[TR]
[TD]0064100000CMLWD[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]100[/TD]
[TD]95[/TD]
[TD]ABC123[/TD]
[TD]XYZ123[/TD]
[TD]Travel[/TD]
[TD]New[/TD]
[TD]6/6/2018[/TD]
[TD]9[/TD]
[TD]$190,000.00[/TD]
[TD]$650,866.00[/TD]
[TD]$941,439.00[/TD]
[TD]$1,592,305.00[/TD]
[/TR]
[TR]
[TD]0064100000CMLY7[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]100[/TD]
[TD]95[/TD]
[TD]ABC124[/TD]
[TD]XYZ124[/TD]
[TD]Travel[/TD]
[TD]New[/TD]
[TD]5/30/2018[/TD]
[TD]16[/TD]
[TD]$117,188.00[/TD]
[TD]$993,996.00[/TD]
[TD]$682,723.00[/TD]
[TD]$1,676,719.00[/TD]
[/TR]
[TR]
[TD]0064100000Chl2B[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]40[/TD]
[TD]25[/TD]
[TD]ABC125[/TD]
[TD]XYZ125[/TD]
[TD]Travel[/TD]
[TD]New[/TD]
[TD]6/14/2018[/TD]
[TD]1[/TD]
[TD]$35,000.00[/TD]
[TD]$532,134.00[/TD]
[TD]$878,368.00[/TD]
[TD]$1,410,502.00[/TD]
[/TR]
[TR]
[TD]0064100000Egf7L[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]25[/TD]
[TD]5[/TD]
[TD]ABC126[/TD]
[TD]XYZ126[/TD]
[TD]Travel[/TD]
[TD]New[/TD]
[TD]6/7/2018[/TD]
[TD]8[/TD]
[TD]$50,000.00[/TD]
[TD]$959,956.00[/TD]
[TD]$923,252.00[/TD]
[TD]$1,883,208.00[/TD]
[/TR]
[TR]
[TD]0064100000FEqmM[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]25[/TD]
[TD]5[/TD]
[TD]ABC127[/TD]
[TD]XYZ127[/TD]
[TD]Travel[/TD]
[TD]New[/TD]
[TD]5/31/2018[/TD]
[TD]15[/TD]
[TD]$50,000.00[/TD]
[TD]$593,839.00[/TD]
[TD]$297,582.00[/TD]
[TD]$891,421.00[/TD]
[/TR]
[TR]
[TD]0064100000FyJGW[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]100[/TD]
[TD]95[/TD]
[TD]ABC128[/TD]
[TD]XYZ128[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]5/29/2018[/TD]
[TD]17[/TD]
[TD]$120,000.00[/TD]
[TD]$995,399.00[/TD]
[TD]$574,795.00[/TD]
[TD]$1,570,194.00[/TD]
[/TR]
[TR]
[TD]0064100000GInah[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]75[/TD]
[TD]50[/TD]
[TD]ABC129[/TD]
[TD]XYZ129[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]6/13/2018[/TD]
[TD]2[/TD]
[TD]$26,000.00[/TD]
[TD]$716,872.00[/TD]
[TD]$531,627.00[/TD]
[TD]$1,248,499.00[/TD]
[/TR]
[TR]
[TD]0064100000GInrJ[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]95[/TD]
[TD]85[/TD]
[TD]ABC130[/TD]
[TD]XYZ130[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]6/7/2018[/TD]
[TD]8[/TD]
[TD]$90,000.00[/TD]
[TD]$638,496.00[/TD]
[TD]$324,997.00[/TD]
[TD]$963,493.00[/TD]
[/TR]
[TR]
[TD]0064100000GIo4N[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]100[/TD]
[TD]95[/TD]
[TD]ABC131[/TD]
[TD]XYZ131[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]5/29/2018[/TD]
[TD]17[/TD]
[TD]$41,000.00[/TD]
[TD]$626,325.00[/TD]
[TD]$782,363.00[/TD]
[TD]$1,408,688.00[/TD]
[/TR]
[TR]
[TD]0064100000GIr1U[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]100[/TD]
[TD]95[/TD]
[TD]ABC132[/TD]
[TD]XYZ132[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]6/12/2018[/TD]
[TD]3[/TD]
[TD]$7,500.00[/TD]
[TD]$971,209.00[/TD]
[TD]$274,300.00[/TD]
[TD]$1,245,509.00[/TD]
[/TR]
[TR]
[TD]0064100000GLmHb[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]100[/TD]
[TD]95[/TD]
[TD]ABC133[/TD]
[TD]XYZ133[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]6/4/2018[/TD]
[TD]11[/TD]
[TD]$28,848.00[/TD]
[TD]$334,215.00[/TD]
[TD]$735,878.00[/TD]
[TD]$1,070,093.00[/TD]
[/TR]
[TR]
[TD]0064100000GLtlD[/TD]
[TD]Bob Smith[/TD]
[TD]National[/TD]
[TD]50[/TD]
[TD]5[/TD]
[TD]ABC134[/TD]
[TD]XYZ134[/TD]
[TD]Travel[/TD]
[TD]New[/TD]
[TD]6/11/2018[/TD]
[TD]4[/TD]
[TD]$250,000.00[/TD]
[TD]$771,801.00[/TD]
[TD]$474,450.00[/TD]
[TD]$1,246,251.00[/TD]
[/TR]
[TR]
[TD]0064100000GLusp[/TD]
[TD]Bob Smith[/TD]
[TD]National[/TD]
[TD]75[/TD]
[TD]40[/TD]
[TD]ABC135[/TD]
[TD]XYZ135[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]5/29/2018[/TD]
[TD]17[/TD]
[TD]$400,000.00[/TD]
[TD]$409,341.00[/TD]
[TD]$738,747.00[/TD]
[TD]$1,148,088.00[/TD]
[/TR]
[TR]
[TD]0064100000GM6IV[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]95[/TD]
[TD]85[/TD]
[TD]ABC136[/TD]
[TD]XYZ136[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]6/13/2018[/TD]
[TD]2[/TD]
[TD]$72,000.00[/TD]
[TD]$989,813.00[/TD]
[TD]$607,033.00[/TD]
[TD]$1,596,846.00[/TD]
[/TR]
[TR]
[TD]0064100000HPWIg[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]100[/TD]
[TD]95[/TD]
[TD]ABC137[/TD]
[TD]XYZ137[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]6/4/2018[/TD]
[TD]11[/TD]
[TD]$152,000.00[/TD]
[TD]$804,147.00[/TD]
[TD]$870,487.00[/TD]
[TD]$1,674,634.00[/TD]
[/TR]
[TR]
[TD]0064100000HPWMx[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]100[/TD]
[TD]95[/TD]
[TD]ABC138[/TD]
[TD]XYZ138[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]6/6/2018[/TD]
[TD]9[/TD]
[TD]$8,000.00[/TD]
[TD]$836,409.00[/TD]
[TD]$912,215.00[/TD]
[TD]$1,748,624.00[/TD]
[/TR]
[TR]
[TD]0064100000HPWOe[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]100[/TD]
[TD]95[/TD]
[TD]ABC139[/TD]
[TD]XYZ139[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]5/30/2018[/TD]
[TD]16[/TD]
[TD]$76,808.00[/TD]
[TD]$220,144.00[/TD]
[TD]$914,156.00[/TD]
[TD]$1,134,300.00[/TD]
[/TR]
[TR]
[TD]0064100000HPWXW[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]95[/TD]
[TD]85[/TD]
[TD]ABC140[/TD]
[TD]XYZ140[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]5/29/2018[/TD]
[TD]17[/TD]
[TD]$15,000.00[/TD]
[TD]$133,979.00[/TD]
[TD]$193,746.00[/TD]
[TD]$327,725.00[/TD]
[/TR]
[TR]
[TD]0064100000HPWc2[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]95[/TD]
[TD]85[/TD]
[TD]ABC141[/TD]
[TD]XYZ141[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]5/29/2018[/TD]
[TD]17[/TD]
[TD]$46,000.00[/TD]
[TD]$863,354.00[/TD]
[TD]$149,726.00[/TD]
[TD]$1,013,080.00[/TD]
[/TR]
[TR]
[TD]0064100000HPWdU[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]100[/TD]
[TD]95[/TD]
[TD]ABC142[/TD]
[TD]XYZ142[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]6/1/2018[/TD]
[TD]14[/TD]
[TD]$47,000.00[/TD]
[TD]$295,988.00[/TD]
[TD]$48,053.00[/TD]
[TD]$344,041.00[/TD]
[/TR]
[TR]
[TD]0064100000HPWuG[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]95[/TD]
[TD]85[/TD]
[TD]ABC143[/TD]
[TD]XYZ143[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]6/13/2018[/TD]
[TD]2[/TD]
[TD]$36,000.00[/TD]
[TD]$725,882.00[/TD]
[TD]$740,921.00[/TD]
[TD]$1,466,803.00[/TD]
[/TR]
[TR]
[TD]0064100000HPWvn[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]100[/TD]
[TD]95[/TD]
[TD]ABC144[/TD]
[TD]XYZ144[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]6/6/2018[/TD]
[TD]9[/TD]
[TD]$25,000.00[/TD]
[TD]$205,745.00[/TD]
[TD]$207,827.00[/TD]
[TD]$413,572.00[/TD]
[/TR]
[TR]
[TD]0064100000IhMyZ[/TD]
[TD]Bob Smith[/TD]
[TD]National[/TD]
[TD]95[/TD]
[TD]85[/TD]
[TD]ABC145[/TD]
[TD]XYZ145[/TD]
[TD]Travel[/TD]
[TD]New[/TD]
[TD]6/14/2018[/TD]
[TD]1[/TD]
[TD]$300,000.00[/TD]
[TD]$683,260.00[/TD]
[TD]$19,420.00[/TD]
[TD]$702,680.00[/TD]
[/TR]
[TR]
[TD]0064100000JdGOp[/TD]
[TD]Bob Smith[/TD]
[TD]National[/TD]
[TD]75[/TD]
[TD]50[/TD]
[TD]ABC146[/TD]
[TD]XYZ146[/TD]
[TD]Travel[/TD]
[TD]New[/TD]
[TD]5/29/2018[/TD]
[TD]17[/TD]
[TD]$300,000.00[/TD]
[TD]$26,221.00[/TD]
[TD]$472,009.00[/TD]
[TD]$498,230.00[/TD]
[/TR]
[TR]
[TD]0064100000JtAA4[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]100[/TD]
[TD]95[/TD]
[TD]ABC147[/TD]
[TD]XYZ147[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]5/31/2018[/TD]
[TD]15[/TD]
[TD]$80,000.00[/TD]
[TD]$51,442.00[/TD]
[TD]$620,841.00[/TD]
[TD]$672,283.00[/TD]
[/TR]
[TR]
[TD]0064100000LEQWb[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]95[/TD]
[TD]75[/TD]
[TD]ABC148[/TD]
[TD]XYZ148[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]5/30/2018[/TD]
[TD]16[/TD]
[TD]$35,000.00[/TD]
[TD]$604,109.00[/TD]
[TD]$485,938.00[/TD]
[TD]$1,090,047.00[/TD]
[/TR]
[TR]
[TD]0064100000LEQoz[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]100[/TD]
[TD]95[/TD]
[TD]ABC149[/TD]
[TD]XYZ149[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]5/31/2018[/TD]
[TD]15[/TD]
[TD]$40,000.00[/TD]
[TD]$198,456.00[/TD]
[TD]$745,859.00[/TD]
[TD]$944,315.00[/TD]
[/TR]
[TR]
[TD]0064100000LER66[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]100[/TD]
[TD]95[/TD]
[TD]ABC150[/TD]
[TD]XYZ150[/TD]
[TD]Travel[/TD]
[TD]New[/TD]
[TD]6/11/2018[/TD]
[TD]4[/TD]
[TD]$125,000.00[/TD]
[TD]$228,145.00[/TD]
[TD]$724,502.00[/TD]
[TD]$952,647.00[/TD]
[/TR]
[TR]
[TD]0064100000LEctF[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]100[/TD]
[TD]95[/TD]
[TD]ABC151[/TD]
[TD]XYZ151[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]5/30/2018[/TD]
[TD]16[/TD]
[TD]$55,000.00[/TD]
[TD]$46,831.00[/TD]
[TD]$757,383.00[/TD]
[TD]$804,214.00[/TD]
[/TR]
[TR]
[TD]0064100000LEpn5[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]95[/TD]
[TD]75[/TD]
[TD]ABC152[/TD]
[TD]XYZ152[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]5/30/2018[/TD]
[TD]16[/TD]
[TD]$175,000.00[/TD]
[TD]$685,991.00[/TD]
[TD]$241,713.00[/TD]
[TD]$927,704.00[/TD]
[/TR]
[TR]
[TD]0064100000LF9Me[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]85[/TD]
[TD]75[/TD]
[TD]ABC153[/TD]
[TD]XYZ153[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]5/31/2018[/TD]
[TD]15[/TD]
[TD]$70,000.00[/TD]
[TD]$26,335.00[/TD]
[TD]$424,195.00[/TD]
[TD]$450,530.00[/TD]
[/TR]
[TR]
[TD]0064100000LF9ND[/TD]
[TD]Bob Smith[/TD]
[TD]Local[/TD]
[TD]100[/TD]
[TD]95[/TD]
[TD]ABC154[/TD]
[TD]XYZ154[/TD]
[TD]Travel[/TD]
[TD]Renewal[/TD]
[TD]6/6/2018[/TD]
[TD]9[/TD]
[TD]$38,571.00[/TD]
[TD]$962,382.00[/TD]
[TD]$377,739.00[/TD]
[TD]$1,340,121.00[/TD]
[/TR]
</tbody>[/TABLE]


I tried to figure out how to upload a file but I can't....thank you again for your help with this!
 
Upvote 0
Ok, how about
Code: 
Sub FilterCopy()
   Dim Ary As Variant
   Dim i As Long
   Ary = Array(50, 75, 85, 95, 100)
   
   For i = 0 To UBound(Ary)
      With Sheets("Sheet1")
         If .AutoFilterMode Then .AutoFilterMode = False
         With .Range("A1:O1")
            .AutoFilter 3, "National"
            .AutoFilter 4, Ary(i)
         End With
         Sheets.Add(, Sheets(Sheets.Count)).name = Ary(i)
         Intersect(.AutoFilter.Range, .Range("B:B,D:G,J:O")).Copy Sheets(CStr(Ary(i))).Range("A1")
         .AutoFilterMode = False
      End With
   Next i
End Sub
 
Upvote 0
AMAZING!!! IT WORKED!!!

THANK YOU

Last question - I swear.

I want to format the sheets after the output is finished. I recorded a macro of me doing the formatting.

1) Where in the above macro you wrote can I copy and paste it?
2) Do I have to rewrite it for each sheet? (50, 75, etc)?

THANK YOU AGAIN!!!

Code: 
Sub Formatting()
'
' Formatting Macro
'


'
    Cells.Select
    Cells.EntireColumn.AutoFit
    Columns("H:K").Select
    Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
    Range("F1").Select
    ActiveWorkbook.Worksheets("50").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("50").Sort.SortFields.Add Key:=Range("F1"), SortOn _
        :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("50").Sort
        .SetRange Range("A2:K10000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
 
Last edited by a moderator:
Upvote 0
Try
Code: 
Sub Filtercopy()
   Dim ary As Variant
   Dim i As Long
   ary = Array(50, 75, 85, 95, 100)
   
   For i = 0 To UBound(ary)
      With Sheets("Sheet1")
         If .AutoFilterMode Then .AutoFilterMode = False
         With .Range("A1:O1")
            .AutoFilter 3, "National"
            .AutoFilter 4, ary(i)
         End With
         Sheets.Add(, Sheets(Sheets.Count)).name = ary(i)
         Intersect(.AutoFilter.Range, .Range("B:B,D:G,J:O")).Copy Sheets(CStr(ary(i))).Range("A1")
         .AutoFilterMode = False
      End With
   Next i
   For Each sht In ary
      With Sheets(CStr(sht))
         .UsedRange.EntireColumn.AutoFit
         .Range("H:K").NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
         With .Sort
            .SortFields.Clear
            .SortFields.Add key:=Range("F1"), SortOn _
               :=xlSortOnValues, order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Range("A2:K10000")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
         End With
      End With
   Next sht
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
VBA sending an email of two conditions are met
Replies
5
Views
137
mumps
mumps
C
  • Solved
VBA macro: insert row if condition is met and apply formulae
Replies
3
Views
317
CXsjr
C
R
  • Solved
Excel VBA to filter by unique value, copy paste into new workbook and save
Replies
2
Views
820
rittersportyummy
R
L
  • Solved
VBA - Copy All Cells Highlighted from Conditional Formatting to Another Sheet
Replies
4
Views
145
luckee
L
ChrisMac1
  • Question Question
VBA - Compare specific data in one column on one sheet, with the same column on 4 other sheets, copy specific cells if match found.
Replies
1
Views
390
ChrisMac1
ChrisMac1

Forum statistics

Threads
1,223,888
Messages
6,175,217
Members
452,619
Latest member
Shiv1198

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