une macro pour plusieurs feuilles

Option Explicit
  
Public Const WSBase As String = "Feuille3 de Eq1"
Sub Equipe3_A()

Dim Rangebase As String, RangeCopy As String, RowCopy As Integer, Nom As String
Dim nbjoueurs As Byte, nbrencontres As Byte, offsetjoueur As Byte, i As Byte, j As Byte
Application.ScreenUpdating = False

nbjoueurs = 3       'nombre de joueurs
nbrencontres = 3    'nombre de rencontres par joueur
offsetjoueur = 7    'différence de lignes entre 2 joueurs

For i = 1 To nbjoueurs
     
    Rangebase = "c" & (2 + offsetjoueur * (i - 1)) 'C2 puis C9...
    'vérification présence nom de joueur
    If Not InStr(1, Sheets(WSBase).Range(Rangebase).Value, " ") < 1 Then
         With Sheets(WSBase).Range(Rangebase)
        Nom = Application.WorksheetFunction.Proper(Left(.Value, InStr(1, .Value, " ") + 1) + ".")
        End With
        For j = 1 To nbrencontres
            'test validité ligne par ligne d'où RangeCount =  1 ligne à la fois, fixe
            If Not Range("I" & (4 + offsetjoueur * (i - 1) + j)).Value = "" Then
                RangeCopy = "B" & (4 + offsetjoueur * (i - 1) + j) & _
                            ":I" & (4 + offsetjoueur * (i - 1) + j)
                Equipe Rangebase, RangeCopy, Nom
            End If
        Next
    End If
Next i
Sheets("Eq3").Activate
Application.ScreenUpdating = True
End Sub

Dim WS() As String ' ou direct : Dim WS(1 to 10) as String, sans redim
Dim x As Integer

ReDim WS(1 to WorkSheets.Count) ' à supprimer si nombre fixe-voir ci-dessus
For x = 1 To 10
    Set WS(x) = "Feuille3 de Eq" &  x
Next

Sub Equipe(Rangebase As String, RangeCopy As String, Nom As String)
Dim Lig1 As Integer, Lig2 As Integer
Dim i As Integer
  
Application.ScreenUpdating = False
   Sheets(WSBase).Range(RangeCopy).Copy
    
   With Sheets(Nom)

        'copie mise en forme et valeur
        .Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
        .Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
        Lig1 = .Range("A65536").End(xlUp).Row
        Lig2 = .Range("J65536").End(xlUp).Row + 1
        .Range("A4:H" & Lig1).Validation.Delete
        Range(.Range("A4"), .Range("H" & Lig1)).Sort Key1:=.Range("A4"), Order1:=xlAscending
        If Lig1 > Lig2 - 1 Then
            Range(.Range("J" & Lig2 - 1), .Range("M" & Lig2 - 1)).AutoFill _
            Destination:=Range(.Range("J" & Lig2 - 1), .Range("M" & Lig1)), Type:=xlFillDefault
        End If
   End With
    
   Sheets(WSBase).Activate
  
Application.ScreenUpdating = True
End Sub