how to run these macros on all sheets

[sl1990]

hi ive got this these macros bellow i want to run them on all the sheets in the workbook named 150 of them. named sheet1 to sheet150

theses are the macros

Sub Bookies_names_to_every_row_2()

    Range("B1:S1").Select
    Selection.Copy
    Range("B3:S3").Select
    ActiveSheet.Paste

    Range("B1:S1").Select
    Selection.Copy
    Range("B6:S6").Select
    ActiveSheet.Paste

    Range("B1:S1").Select
    Selection.Copy
    Range("B9:S9").Select
    ActiveSheet.Paste

    Range("B1:S1").Select
    Selection.Copy
    Range("B12:S12").Select
    ActiveSheet.Paste
  
    Range("B1:S1").Select
    Selection.Copy
    Range("B15:S15").Select
    ActiveSheet.Paste

    Range("B1:S1").Select
    Selection.Copy
    Range("B18:S18").Select
    ActiveSheet.Paste

    Range("B1:S1").Select
    Selection.Copy
    Range("B21:S21").Select
    ActiveSheet.Paste

    Range("B1:S1").Select
    Selection.Copy
    Range("B24:S24").Select
    ActiveSheet.Paste

    Range("B1:S1").Select
    Selection.Copy
    Range("B27:S27").Select
    ActiveSheet.Paste

    Range("B1:S1").Select
    Selection.Copy
    Range("B30:S30").Select
    ActiveSheet.Paste

    Range("B1:S1").Select
    Selection.Copy
    Range("B33:S33").Select
    ActiveSheet.Paste

    Range("B1:S1").Select
    Selection.Copy
    Range("B36:S36").Select
    ActiveSheet.Paste

    Range("B1:S1").Select
    Selection.Copy
    Range("B39:S39").Select
    ActiveSheet.Paste

    Range("B1:S1").Select
    Selection.Copy
    Range("B42:S42").Select
    ActiveSheet.Paste

    Range("B1:S1").Select
    Selection.Copy
    Range("B45:S45").Select
    ActiveSheet.Paste

    Range("B1:S1").Select
    Selection.Copy
    Range("B48:S48").Select
    ActiveSheet.Paste

    Range("B1:S1").Select
    Selection.Copy
    Range("B51:S51").Select
    ActiveSheet.Paste

    Range("B1:S1").Select
    Selection.Copy
    Range("B54:S54").Select
    ActiveSheet.Paste

    Range("B1:S1").Select
    Selection.Copy
    Range("B57:S57").Select
    ActiveSheet.Paste

    Range("B1:S1").Select
    Selection.Copy
    Range("B60:S60").Select
    ActiveSheet.Paste

    Application.CutCopyMode = False

End Sub

AND

Sub HorseRank_1()

Range("X3").Value = "Place"
Range("Y3").Value = "Name(s)"
Range("X4").Value = "1st"
Range("Y4:Y100").Value = ""
On Error Resume Next
For Each cell In Range("B4:S4")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B4:S4"), 0)
Next
For i = 1 To 10
For Each cell In Range("B5:S5")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("Y" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B5:S5").ClearContents
Range("Y5:Y100").ClearContents

End Sub

how would i do this without having to use

"Call (macro name)_sheet1"
"Call (macro name)_sheet2"

ect as id have to type in the sheet number 150 times

any ideas?

 

[Rick Rothstein]

I don't have time right now (I'm going out) to answer the question you asked (if no one answers it by the time I get back, I'll tackle it for you); however, I wanted to point out that your Bookies_names_to_every_row_2 macro can be simplified to this...

Sub Bookies_names_to_every_row_2()
  Dim X As Long
  For X = 3 To 60 Step 3
    Range("B" & X & ":S" & X).Value = Range("B1:S1").Value
  Next
End Sub

 

[asking]

You need to put the macro's in the Personal.xlsb
If you haven't used it before you will first have to create it.

Open the help file and type personal and follow instructions.

If you have used the personal .xlbs before, you can skip the instructions and go to the view menu and in the windows sections click unhide, if the personal workbook has been used before it will show in the dialog box that pops up.

Once the personal workbook opens, insert the macros into a new module or modules by opening the VBA in the developer menu.
You can then click hide so the personal workbook won't show.

 

[jbeaucaire]

Taking Rick's code and expanding it run on every sheet in the active workbook:

Option Explicit

Sub Bookies_names_to_every_row_2()
Dim Rw As Long
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
    For Rw = 3 To 60 Step 3
        ws.Range("B" & Rw & ":S" & Rw).Value = ws.Range("B1:S1").Value
    Next
Next ws

End Sub

 

[jbeaucaire]

The second macro could be:

Sub HorseRank_1()
Dim cell     As Range
Dim ws       As Worksheet
Dim i        As Long
Dim setPlace As String

On Error Resume Next
Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Worksheets
    ws.Range("X3") = "Place"
    ws.Range("Y3") = "Name(s)"
    ws.Range("X4") = "1st"
    ws.Range("Y4:Y100").ClearContents
    
    For Each cell In ws.Range("B4:S4")
        cell.Offset(1, 0).Value = Application.Rank(cell.Value, ws.Range("B4:S4"), 0)
    Next
    
    For i = 1 To 10
        For Each cell In ws.Range("B5:S5")
            If cell.Value = i Then _
                setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
        Next cell
        ws.Range("Y" & ws.Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
        setPlace = ""
    Next i
    
    ws.Range("B5:S5,Y5:Y100").ClearContents
Next ws

Application.ScreenUpdating = True
End Sub