Sub Alea_bis()
Cells(2, 1) = "Depart : " & Time
Dim T1() As Double
ReDim T1(1 To 1, 1 To 6)
Dim T2() As Double
ReDim T2(1 To 1)
x = 1
'Dim cel As Range
Dim a, b, c, d, e, f As Integer
For a = 1 To 70
For b = a + 1 To 70
For c = b + 1 To 70
For d = c + 1 To 70
For e = d + 1 To 70
For f = e + 1 To 70
Application.StatusBar = "For pos a = " & a & " (soit 70 reste " & 70 - a & " )" & " / " & _
"For pos b = " & b & " (soit 70 reste " & 70 - b & " )" & " / " & _
"For pos c = " & c & " (soit 70 reste " & 70 - c & " )" & " / " & _
"For pos d = " & d & " (soit 70 reste " & 70 - d & " )" & " / " & _
"For pos e = " & e & " (soit 70 reste " & 70 - e & " )" & " / " & _
"For pos f = " & f & " (soit 70 reste " & 70 - f & " )" & " / "
'Range("G1") = a
T1(1, 1) = a
'Range("H1") = b
T1(1, 2) = b
'Range("I1") = c
T1(1, 3) = c ''
'Range("J1") = d
T1(1, 4) = d
'Range("K1") = e
T1(1, 5) = e
'Range("L1") = f
T1(1, 6) = f
If [R1] = 0 Then
'[G1:L1].Copy Range("Y" & Cells(Rows.Count, 28).End(xlUp).Row + 1) ' mis un exemple nb.si pour test de copie si =0
For g = 1 To UBound(T1, 2)
T2(x) = T1(1, g)
x = x + 1
ReDim Preserve T2(1 To x)
Next g
End If
Next
Next
Next
Next
Next
Next
' Suppression de la derniere case crée du tableau a une dimenssion inutile
' voir la boucle "for g" ou x = x + 1
x = x - 1
ReDim Preserve T2(1 To x)
lign = 1
col = 1
For h = 1 To UBound(T2)
If col > 6 Then
col = 1
lign = lign + 1
End If
Cells(5 + lign, 24 + col) = T2(h)
col = col + 1
Next h
Cells(3, 1) = "Fin : " & Time
Application.StatusBar = False
End Sub