Loop Macro on all worksheets

S

shebe228

New Member
Joined
Sep 28, 2017
Messages
46
Can someone help me loop this macro on all worksheets? (theres 47)

Code: 
Sub AM2_Format_Util_Template()
'
' AM2_Format_Util_Template Macro
'


'
    Columns("AC:AC").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("W:W").Select
    ActiveSheet.Paste
    Columns("AG:AG").Select
    ActiveSheet.Paste
    Columns("A:T").Select
    Range("T1").Activate
    Selection.EntireColumn.Hidden = True
    Columns("U:AC").Select
    Range("AC1").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Columns("AD:AD").Select
    Selection.Insert Shift:=xlToRight
    Columns("AO:BB").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("BD:BD").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("AMC").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("AMC").Sort.SortFields.Add Key:=Range("BG2:BG38090" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("AMC").Sort
        .SetRange Range("BD1:BQ38090")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("AO:BB").Select
    ActiveWorkbook.Worksheets("AMC").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("AMC").Sort.SortFields.Add Key:=Range("AQ2:AQ38091" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("AMC").Sort
        .SetRange Range("AO1:BB38091")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SmallScroll ToRight:=-15
    Columns("AE:AL").Select
    Range("AL1").Activate
    ActiveWorkbook.Worksheets("AMC").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("AMC").Sort.SortFields.Add Key:=Range("AL2:AL38092" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("AMC").Sort.SortFields.Add Key:=Range("AH2:AH38092" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("AMC").Sort
        .SetRange Range("AE1:AL38092")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("V:AC").Select
    Range("AC1").Activate
    ActiveWorkbook.Worksheets("AMC").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("AMC").Sort.SortFields.Add Key:=Range("AC2:AC38093" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("AMC").Sort.SortFields.Add Key:=Range("X2:X38093") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("AMC").Sort
        .SetRange Range("V1:AC38093")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Sort by date Sort by votes
In relation to the loop.

Code: 
Sub loopthroughsheets()


Dim ws As Worksheet


For Each ws In ActiveWorkbook.Worksheets

ws.select
'your code here


Next ws


End Sub
 
Last edited:
Upvote 0
Totally untested so test on a copy of your workbook....

Code: 
Sub AM2_Format_Util_Template()
    Dim ws As Worksheet
    Application.ScreenUpdating = False
    For Each ws In ActiveWorkbook.Worksheets
        With ws
            .Columns("AC:AC").Copy 
            .Columns("AC:AC").PasteSpecial Paste:=xlPasteValues
            .Columns("B:B").Copy
            .Columns("W:W").PasteSpecial
            .Columns("AG:AG").PasteSpecial
            .Columns("A:T").EntireColumn.Hidden = True
            .Columns("U:AC").Copy
            .Columns("AD:AD").Insert Shift:=xlToRight
             Application.CutCopyMode = False
            .Columns("AO:BB").Copy .Range("BD1")
            
            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=.Range("BG2:BG38090" _
                                             ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            With .Sort
                .SetRange Parent.Range("BD1:BQ38090")
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=Range("AQ2:AQ38091" _
                                            ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            With .Sort
                .SetRange Parent.Range("AO1:BB38091")
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With

            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=.Range("AL2:AL38092" _
                                             ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            .Sort.SortFields.Add Key:=.Range("AH2:AH38092" _
                                             ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            With .Sort
                .SetRange Parent.Range("AE1:AL38092")
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=.Range("AC2:AC38093" _
                                             ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            .Sort.SortFields.Add Key:=.Range("X2:X38093") _
                                      , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            With .Sort
                .SetRange Parent.Range("V1:AC38093")
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End With
    Next
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Mark858 -

Any chance you could help with this one too? :eeek: I tried to follow your code to edit mine to match and it does not work. Instead it adds 68 columns of the same formula.

The code recorded with Macro Recorder:
Code: 
Sub AM5_IN_Filter_Discounts()
'
' AM5_IN_Filter_Discounts Macro
' Adds two new columns with if statements for less than 10%.  Sorts by Yes-Less than 10% then by Bill Count and Allowed
'


'
    Columns("BC:BC").Select
    Selection.Insert Shift:=xlToRight
    Range("AT2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Replace What:="", Replacement:="0%", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ActiveWindow.ScrollRow = 3792
    ActiveWindow.ScrollRow = 3739
    ActiveWindow.ScrollRow = 3098
    ActiveWindow.ScrollRow = 2884
    ActiveWindow.ScrollRow = 268
    ActiveWindow.ScrollRow = 1
    Range("BC1").Select
    ActiveCell.FormulaR1C1 = ">10%"
    Range("BC2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-9]>10%,""yes"",""no"")"
    Range("BC2").Select
    Selection.AutoFill Destination:=Range("BC2:BC3809")
    Range("BC2:BC3809").Select
    Columns("AO:BC").Select
    Range("BC1").Activate
    Application.AddCustomList ListArray:=Array("no", "yes")
    ActiveWorkbook.Worksheets("AIG").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("AIG").Sort.SortFields.Add Key:=Range("BC2:BC38068" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="no,yes", _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("AIG").Sort
        .SetRange Range("AO1:BC38068")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("AIG").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("AIG").Sort.SortFields.Add Key:=Range("BC2:BC38069" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="no,yes", _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("AIG").Sort.SortFields.Add Key:=Range("AQ2:AQ38069" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("AIG").Sort
        .SetRange Range("AO1:BC38069")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("BC:BC").Select
    Selection.Copy
    Columns("BS:BS").Select
    ActiveSheet.Paste
    Columns("BE:BS").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("AIG").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("AIG").Sort.SortFields.Add Key:=Range("BS2:BS38070" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="no,yes", _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("AIG").Sort.SortFields.Add Key:=Range("BH2:BH38070" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("AIG").Sort
        .SetRange Range("BE1:BS38070")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

I changed all active sheets and removed the part where I added a custom list- oops! and this is what I edited it too where it adds 60 something rows of the same formula
Code: 
Sub AM5_IN_Filter_Discounts()
'
' AM5_IN_Filter_Discounts Macro
' Adds two new columns with if statements for less than 10%.  Sorts by Yes-Less than 10% then by Bill Count and Allowed
'
    Dim ws As Worksheet
    Application.ScreenUpdating = False
    For Each ws In ActiveWorkbook.Worksheets
        With ws'
            Columns("BC:BC").Select
             Selection.Insert Shift:=xlToRight
            Range("BC1").Select
            ActiveCell.FormulaR1C1 = ">10%"
            Range("BC2").Select
            ActiveCell.FormulaR1C1 = "=IF(RC[-9]>10%,""yes"",""no"")"
             Range("BC2").Select
            Selection.AutoFill Destination:=Range("BC2:BC38090")
            Range("BC2:BC38090").Select
            Columns("AO:BC").Select
            Range("BC1").Activate
   
             .Sort.SortFields.Clear
             .Sort.SortFields.Add Key:=Range("BC2:BC38069" _
                        ), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="no,yes", DataOption:=xlSortNormal
            .Sort.SortFields.Add Key:=Range("AQ2:AQ38069" _
                    ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            With .Sort
                .SetRange Parent.Range("AO1:BC38069")
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With


            Columns("BC:BC").Select
            Selection.Copy
           Columns("BS:BS").Select
            ActiveSheet.Paste
            Columns("BE:BS").Select
            Application.CutCopyMode = False


            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=Range("BS2:BS38070" _
                    ), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="no,yes", DataOption:=xlSortNormal
            .Sort.SortFields.Add Key:=Range("BH2:BH38070" _
                    ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            With .Sort
                .SetRange Parent.Range("BE1:BS38070")
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
    End With
    Next
    Application.ScreenUpdating=True
    
End Sub
 
Upvote 0
This code is tested and does work. I just need to figure out the active sheets and loop.

Code: 
Sub AM5_IN_Filter_Discounts()
'
' AM5_IN_Filter_Discounts Macro
' Adds two new columns with if statements for less than 10%.  Sorts by Yes-Less than 10% then by Bill Count and Allowed
'


'
    Columns("BC:BC").Select
    Selection.Insert Shift:=xlToRight
    
    Range("BC1").Select
    ActiveCell.FormulaR1C1 = ">10%"
    Range("BC2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-9]>10%,""yes"",""no"")"
    Range("BC2").Select
    Selection.AutoFill Destination:=Range("BC2:BC3809")
    Range("BC2:BC3809").Select
    Columns("AO:BC").Select
    Range("BC1").Activate
    ActiveWorkbook.Worksheets("AIG").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("AIG").Sort.SortFields.Add Key:=Range("BC2:BC38068" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="no,yes", _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("AIG").Sort
        .SetRange Range("AO1:BC38068")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("AIG").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("AIG").Sort.SortFields.Add Key:=Range("BC2:BC38069" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="no,yes", _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("AIG").Sort.SortFields.Add Key:=Range("AQ2:AQ38069" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("AIG").Sort
        .SetRange Range("AO1:BC38069")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("BC:BC").Select
    Selection.Copy
    Columns("BS:BS").Select
    ActiveSheet.Paste
    Columns("BE:BS").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("AIG").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("AIG").Sort.SortFields.Add Key:=Range("BS2:BS38070" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="no,yes", _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("AIG").Sort.SortFields.Add Key:=Range("BH2:BH38070" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("AIG").Sort
        .SetRange Range("BE1:BS38070")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
 
Upvote 0
I just need to figure out the active sheets and loop
Click to expand...

I don't what you mean by "figure out the active sheets" or what you want the loop to do as you haven't stated it.
Below I have tidied up your code a little bit (I think correctly but you will have to test that). What I will say (and I haven't changed it) is you are asking for problems if you leave formulas in cells when sorting.

If you explain what you actually want "figure out the active sheets and loop" to do then I might be able to help further.

Code: 
Sub AM5_IN_Filter_Discounts()
    '
    ' AM5_IN_Filter_Discounts Macro
    ' Adds two new columns with if statements for less than 10%.  Sorts by Yes-Less than 10% then by Bill Count and Allowed
    '

    With Worksheets("AIG")
        .Columns("BC:BC").Insert Shift:=xlToRight

        .Range("BC1").FormulaR1C1 = ">10%"
        .Range("BC2:BC3809").FormulaR1C1 = "=IF(RC[-9]>10%,""yes"",""no"")"

        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range("BC2"), SortOn:=xlSortOnValues, _
                             Order:=xlAscending, CustomOrder:="no,yes", DataOption:=xlSortNormal
        With .Sort
            .SetRange Parent.Range("AO1:BC38068")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With


        .Sort.SortFields.Add Key:=.Range("AQ2"), SortOn:=xlSortOnValues, _
                             Order:=xlDescending, DataOption:=xlSortNormal

        With .Sort
            .SetRange Parent.Range("AO1:BC38069")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        .Columns("BC:BC").Copy .Columns("BS:BS")

        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range("BS2" _
                ), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="no,yes", _
                                         DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=.Range("BH2" _
                ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        
        With .Sort
            .SetRange Parent.Range("BE1:BS38070")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

    End With
End Sub
 
Upvote 0
I meant change my sheet name to refer to the active sheets. I am going to compare your code to mine and figure out where I went wrong. I do need to add the loop too.
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
A little VBA/Macro code adjustment
Replies
3
Views
262
rollis13
rollis13
P
  • Solved
Macro to scroll to the last coloured cell in a spreadsheet
Replies
4
Views
376
Joe4
Joe4
S
  • Question Question
Help with combining 2 macros into 1
Replies
8
Views
248
MARK858
MARK858
Dazzawm
  • Question Question
Change Recorded Range To Used Range.
2
Replies
12
Views
870
Dazzawm
Dazzawm
G
  • Solved
Filter columns (number of rows keeps changing)
Replies
1
Views
302
myall_blues
myall_blues

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

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