Option Compare Text 'la casse est ignorée
Private Sub CBnTirage_Click()
Dim cible, adrcible, ntir, TNoms(), LOt As ListObject, TRésu(), M As Long, L As Long, J As Long, C As Long
cible = [D30]: adrcible = [D31]
On Error Resume Next
TNoms = [TbProfs[Professeur]].Value
If Err Then MsgBox "Table des professeurs indisponible", vbCritical, "Tirage": Exit Sub
On Error GoTo 0
If UBound(TNoms, 1) Mod 3 > 0 Then MsgBox "Le nombre de professeurs doit être un multiple de 3", vbCritical, "Tirage": End
For ntir = 1 To 100
Set LOt = Me.ListObjects(1): M = (LOt.ListColumns.Count - 1) \ 3
If TiragePSimOK(NbJrs:=UBound(TNoms, 1), MMax:=M, RClubs:=[TbProfs[Etablissement]]) Then
ReDim TRésu(1 To UBound(Tirage, 2), 1 To UBound(Tirage, 1) * 3)
For L = 1 To UBound(Tirage, 2)
C = 0
For M = 1 To UBound(Tirage, 1): For J = 1 To 3
C = C + 1
TRésu(L, C) = TNoms(Tirage(M, L, J), 1)
Next J, M, L
With Me.ListObjects(1).DataBodyRange
L = .Rows.Count - UBound(TRésu, 1)
Select Case Sgn(L)
Case 1: .Rows(2).Resize(L).Delete xlShiftUp
Case -1: .Rows(2).Resize(-L).Insert xlShiftDown
End Select
.Columns(2).Resize(, UBound(TRésu, 2)).Value = TRésu: End With
End If
If Range(adrcible) = cible Then Range(adrcible) = cible: MsgBox "Cible trouvée en " & ntir & " tirages": Exit Sub
Next ntir
MsgBox "Cible NON trouvée"
End Sub