XL pour MAC Répartir des personnes dans des équipes par roulement sur 5 jours

Sub Tirages()
Dim t, ntirage&, ecart1 As Range, ecart2 As Range, a, c As Range, i&, n&, ub%, nn&, x, r1%, r2%
t = Timer
ntirage = 10000
Set ecart1 = [C8]
Set ecart2 = [D8]
Application.ScreenUpdating = False
'---tirages des jours de repos---
ReDim a(1 To 10)
For Each c In [Tableau2].Rows(0).Cells
    i = i + 1: a(i) = c & " " & "AM"
    i = i + 1: a(i) = c & " " & "PM"
Next c
For i = 1 To ntirage
    n = n + 1
    For Each c In [Tableau1].Columns(2).Cells
        c = a(1 + Int(10 * Rnd))
    Next c
    If ecart1 = 0 Then Exit For
Next i
'---tirages des créneaux---
a = [Tableau1].Resize(, 2)
ub = UBound(a)
For i = 1 To ntirage
    nn = nn + 1
    For Each c In [Tableau2]
        x = c(2 - c.Row, 1) & " " & c(1, 2 - c.Column).MergeArea(1)
        Do
            r1 = 1 + Int(ub * Rnd)
        Loop While a(r1, 2) = x
        Do
            r2 = 1 + Int(ub * Rnd)
        Loop While r1 = r2 Or a(r2, 2) = x
        c = a(r1, 1) & vbLf & a(r2, 1)
    Next c
    If ecart2 <= 1 Then Exit For
Next i
Application.ScreenUpdating = True
MsgBox n & " tirages pour les jours de repos" & vbLf & nn & " tirages pour les créneaux" & vbLf & vbLf & "Le tout en " & Format(Timer - t, "0.00") & " seconde(s)"
End Sub