XL 2016 concours de pétanque

Sub Tirage()
Dim a, ub%, b(), d As Object, i%, r%
Randomize
With [B3:B122] 'adaptable
    a = .Value: ub = UBound(a)
    ReDim b(1 To ub, 1 To 1)
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To ub
        Do
            If i = ub Then If Not d.exists(a(i, 1)) Then r = b(1, 1): b(1, 1) = a(i, 1): Exit Do 'sécurité
            r = Application.RandBetween(1, ub)
        Loop While r = a(i, 1) Or d.exists(r)
        b(i, 1) = r
        d(r) = ""
    Next
    .Offset(, 2) = b 'décalage de 2 colonnes, adaptable
End With
End Sub

Sub Tirage()
Dim a, ub%, b(), i%, r%
Randomize
With [B3:B122] 'adaptable
    If .Rows.Count Mod 2 Then MsgBox "Le nombre d'équipes doit être pair...": Exit Sub
    a = .Value: ub = UBound(a)
    ReDim b(1 To ub, 1 To 1)
    For i = 1 To ub
        If b(i, 1) = "" Then
            Do
                r = Application.RandBetween(1, ub)
            Loop While r = i Or b(r, 1) <> ""
            b(i, 1) = a(r, 1)
            b(r, 1) = a(i, 1)
        End If
    Next
    .Offset(, 2) = b 'décalage de 2 colonnes, adaptable
End With
End Sub

With [B3].Resize(Application.Count([B:B]))

With Feuil1.[B3].Resize(Application.Count(Feuil1.[B:B]))

Sub Tirage()
Dim a, ub%, b(), c(), temp(), i%, r%, n%
Randomize
With [B5].Resize(Application.Count([b:b])) 'adaptable
    If .Rows.Count Mod 2 Then MsgBox "Le nombre d'équipes doit être pair...": Exit Sub
    a = .Value: ub = UBound(a)
    ReDim temp(1 To ub / 2)
    ReDim b(1 To ub, 1 To 1)
    ReDim c(1 To ub, 1 To 1)
    For i = 1 To ub / 2
        Do
            r = Application.RandBetween(1, ub / 2)
        Loop While IsNumeric(Application.Match(r, temp, 0))
        temp(i) = r
    Next
    For i = 1 To ub
        If b(i, 1) = "" Then
            Do
                r = Application.RandBetween(1, ub)
            Loop While r = i Or b(r, 1) <> ""
            b(i, 1) = a(r, 1)
            b(r, 1) = a(i, 1)
            n = n + 1
            c(i, 1) = temp(n)
            c(r, 1) = temp(n)
        End If
    Next
    .Offset(, 2) = b 'décalage de 2 colonnes, adaptable
    .Offset(, 4) = c 'décalage de 4 colonnes, adaptable
End With
End Sub