You can give this a try...

Sub Rank()
Dim wks As Worksheet

For Each wks In ActiveWindow.SelectedSheets
wks.Select
ActiveCell.Select
Selection.End(xlToRight).Select

ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=RANK(RC[-8],R10C2:R600C2)"
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveCell.Offset(-475, 0).Range("A1:A476").Select
ActiveCell.Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Next wks
Calculate

End Sub
--
HTH...

Jim Thomlinson


"carl" wrote:

Is there a way I can have this run on all selected worksheets ?

Sub Rank()

ActiveCell.Select
Selection.End(xlToRight).Select

ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=RANK(RC[-8],R10C2:R600C2)"
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveCell.Offset(-475, 0).Range("A1:A476").Select
ActiveCell.Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Calculate

End Sub

Thank you in advance