problem in running macro to all worksheets in a workbook

A

aminexcel

Board Regular
Joined
May 2, 2009
Messages
63
i can not run my macro to all worksheets.
all the worksheets have same structure
worksheet names are 199201 ... 199212

can any one help me
Code: 
Sub Weights()
    Dim LR As Long
    LR = Range("A" & Rows.Count).End(xlUp).Row - 2
'change font before running macro
    Range("A1").CurrentRegion.Select
    With Selection.Font
        .Name = "Tahoma"
        .Size = 8
    End With
' 1-making value from tarrif column
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=VALUE(RC[-4])"
    Range("G2").Select
    Selection.Copy
    Range("F2").Select
    Selection.End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Selection.Copy
' 2-paste special value to tariff column
    Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
' 3-delet column G value formulas
    Columns("G:G").Select
    Application.CutCopyMode = False
    Selection.ClearContents
' 4- sort on tariffs
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("C2").End(xlDown) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range("A1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
' 5- unique list from 10 digit tariff with advance filtering
    Range("G1").Select
    Columns("C:C").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
        "G:G"), Unique:=True
' 6-fitting column G + rename to t10 + sumif
    Columns("G:G").EntireColumn.AutoFit
    ActiveCell.FormulaR1C1 = "t10"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "s10"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=SUMIF(RC[-5]:R[" & LR & "]C[-4],RC[-1],RC[-4]:R[" & LR & "]C[-4])"
    Range("H2").Select
    Selection.Copy
    Range("G2").Select
    Selection.End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Range("H2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
' 7-titling and trunc for driving 8,6,4,2 tariff codes
    Columns("H:K").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "t08"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "t06"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "t04"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "t02"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=TRUNC(RC[-1]/100)"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=TRUNC(RC[-2]/10000)"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=TRUNC(RC[-3]/1000000)"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=TRUNC(RC[-4]/100000000)"
    Range("K2").Select
    Range("H2:K2").Select
    Selection.Copy
    Range("G2").Select
    Selection.End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
' 8- change value to text for sumif and respecting duplicates
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=RIGHT(""00000""&RC[-6],10)"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=RIGHT(""00000""&RC[-6],8)"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "=RIGHT(""00000""&RC[-6],6)"
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "=RIGHT(""00000""&RC[-6],4)"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=RIGHT(""00000""&RC[-6],2)"
    Range("M2:Q2").Select
    Selection.Copy
    Range("L2").Select
    Selection.End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Selection.Copy
    Range("G2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("M:Q").Select
    Application.CutCopyMode = False
    Selection.ClearContents
' 9-unique list for t08,t06,t04,t02
    Range("M1").Select
    Columns("H:H").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
        "M:M"), Unique:=True
    Range("N1").Select
    Columns("I:I").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
        "N:N"), Unique:=True
    Range("O1").Select
    Columns("J:J").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
        "O:O"), Unique:=True
    Range("P1").Select
    Columns("K:K").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
        "P:P"), Unique:=True
' 10-computing weights
' inserting between columns
    Columns("N:N").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("P:P").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("R:R").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
' naming columns
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "s08"
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "s06"
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "s04"
    Range("T1").Select
    ActiveCell.FormulaR1C1 = "s02"
' sumifs
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=SUMIF(RC[-6]:R[" & LR & "]C[-2],RC[-1],RC[-2]:R[" & LR & "]C[-2])"
    Range("N2").Select
    Selection.Copy
    Range("M2").Select
    Selection.End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "=SUMIF(RC[-7]:R[" & LR & "]C[-4],RC[-1],RC[-4]:R[" & LR & "]C[-4])"
    Range("P2").Select
    Selection.Copy
    Range("O2").Select
    Selection.End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "=SUMIF(RC[-8]:R[" & LR & "]C[-6],RC[-1],RC[-6]:R[" & LR & "]C[-6])"
    Range("R2").Select
    Selection.Copy
    Range("Q2").Select
    Selection.End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Range("T2").Select
    ActiveCell.FormulaR1C1 = "=SUMIF(RC[-9]:R[" & LR & "]C[-8],RC[-1],RC[-8]:R[" & LR & "]C[-8])"
    Range("T2").Select
    Selection.Copy
    Range("S2").Select
    Selection.End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
' preparing for weighting
' copy t10 near s10
    Columns("L:L").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("G:G").Select
    Selection.Copy
    Columns("L:L").Select
    ActiveSheet.Paste
' insert columns for weights and titling
    Columns("N:N").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("Q:Q").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("T:T").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("W:W").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "w10"
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = "w08"
    Range("T1").Select
    ActiveCell.FormulaR1C1 = "w06"
    Range("W1").Select
    ActiveCell.FormulaR1C1 = "w04"
    Range("Z1").Select
    ActiveCell.FormulaR1C1 = "w02"
' weight 10 in 08 or w10
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/VLOOKUP(LEFT(RC[-2],8),R2C15:R[" & LR & "]C16,2,0)"
    Range("N2").Select
    Selection.Copy
    Range("M2").Select
    Selection.End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
' weight 08 in 06 or w08
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/VLOOKUP(LEFT(RC[-2],6),R2C18:R[" & LR & "]C19,2,0)"
    Range("Q2").Select
    Selection.Copy
    Range("P2").Select
    Selection.End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
' weight 06 in 04 or w06
    Range("T2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/VLOOKUP(LEFT(RC[-2],4),R2C21:R[" & LR & "]C22,2,0)"
    Range("T2").Select
    Selection.Copy
    Range("S2").Select
    Selection.End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
' weight 04 in 02 or w04
    Range("W2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/VLOOKUP(LEFT(RC[-2],2),R2C24:R[" & LR & "]C25,2,0)"
    Range("W2").Select
    Selection.Copy
    Range("V2").Select
    Selection.End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
'computing 4sigmaw or fore sigma weights
    Columns("L:L").Select
    Selection.Copy
    Columns("AA:AA").Select
    ActiveSheet.Paste
    Range("AB1").Select
    ActiveCell.FormulaR1C1 = "4sigmaw"
    Range("AB2").Select
    ActiveCell.FormulaR1C1 = _
        "=RC[-14]*VLOOKUP(LEFT(RC[-16],8),R2C15:R[" & LR & "]C17,3,0)*VLOOKUP(LEFT(RC[-16],6),R2C18:R[" & LR & "]C20,3,0)*VLOOKUP(LEFT(RC[-16],4),R1C21:R[" & LR & "]C23,3,0)"
    Range("AB2").Select
    Selection.Copy
    Range("AA2").Select
    Selection.End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
' 11-computing weight and prices for t02
    Columns("AB:AB").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AB1").Select
    ActiveCell.FormulaR1C1 = "t02"
    Range("AB2").Select
    ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],2)"
    Range("AB2").Select
    Selection.Copy
    Range("AA2").Select
    Selection.End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Range("AD1").Select
    ActiveCell.FormulaR1C1 = "p2t1"
    Range("AD2").Select
    ActiveCell.FormulaR1C1 = "=RC[-26]/RC[-24]"
    Range("AD2").Select
    Selection.Copy
    Range("AC2").Select
    Selection.End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
'change font and color in the end of work
 Range("G1,H1,I1,J1,K1,L1,O1,R1,U1,X1,AA1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 16756735
    End With
    Range("M1,P1,S1,V1,Y1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 16765067
    End With
    Range("N1,Q1,T1,W1,Z1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10873253
    End With
    Range("AB1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 8519679
    End With
    Range("AD1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 7775700
    End With
    Range("A1").CurrentRegion.Select
    With Selection.Font
        .ColorIndex = xlAutomatic
    End With
    Range("A1").CurrentRegion.Select
    With Selection.Font
        .Name = "Tahoma"
        .Size = 8
    End With
    Range("A1").CurrentRegion.Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
End Sub
 
Last edited:

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
Sort by date Sort by votes
Do you mean that you want to loop through all the worksheets, or that if you run the macro manually it fails on some of the sheets?
And are those the only sheets in the workbook?
 
Upvote 0
yes, i want to run macro to all worksheets, simultaneously not seperately
yes, to all worksheets in a workbook
 
Upvote 0
Well it will always be run one after the other, 'cause that's the way the computer works.
If you only have those sheets in the workbook add to the top, just below the "Sub Weights()" line
Code: 
for each ws in Worksheets
ws.activate
and finally at the very end just above the "End sub" line put in "next so it looks like this
Code: 
Next ws
End Sub

It is not tested, but hopefully works.
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
Help with Vba Code
Replies
3
Views
159
Coyotex3
C
L
  • Solved
VBA remove leading zeros
2
Replies
14
Views
961
Joe4
Joe4
G
  • Question
How can i extract the correct leave time on this code?
Replies
1
Views
362
rlv01
R
C
  • Question
How to get my macro to stop at the last recognized line
Replies
6
Views
208
Coco1
C
L
  • Question
Variable Rows, Help Speeding Up
Replies
4
Views
316
kevin9999
K

Forum statistics

Threads
1,214,908
Messages
6,122,186
Members
449,071
Latest member
cdnMech

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