Sub MulSimple()
Dim r&, a&, i&, Ta() As Boolean, j As Byte, Tb() As Boolean, Tp() As Byte, k&, ii&, u&, jj&, b$, c As Byte
For i = 1 To 3
a = Cells(Rows.Count, i).End(xlUp).Row
If a > r Then r = a
Next i
ReDim Ta(1 To r, 1 To 3)
For i = 1 To r: For j = 1 To 3: Ta(i, j) = Cells(i, j) <> "": Next j, i
For i = 1 To r
a = 0: ReDim Tp(0)
For j = 1 To 3
If Ta(i, j) Then a = a + 1: ReDim Preserve Tp(a): Tp(a) = j
Next j
If i = 1 Then
ReDim Preserve Tb(1 To r, 1 To 3, 1 To a)
For j = 1 To a: Tb(1, Tp(j), j) = True: Next j
Else
u = UBound(Tb, 3)
If a > 1 Then ReDim Preserve Tb(1 To r, 1 To 3, 1 To a * u)
For j = 1 To a: For jj = 1 To u: For k = 1 To i - 1: For ii = 1 To 3
Tb(k, ii, (j - 1) * u + jj) = Tb(k, ii, jj)
Next ii, k
For ii = 1 To 3: Tb(i, Tp(j), (j - 1) * u + jj) = True
Next ii, jj, j
End If
Next i
Erase Ta: Erase Tp
u = UBound(Tb, 3)
If MsgBox(u & " grilles, les afficher?", vbYesNo) = vbYes Then
Sheets.Add
For j = 1 To u: For i = 1 To r: For k = 1 To 3
If k = 2 Then b = "x" Else b = k + (k = 3)
If Tb(i, k, j) Then Cells(i, (j - 1) * 3 + k) = b
Next k, i
c = j Mod 2
Range(Cells(1, (j - 1) * 3 + 1), Cells(r, 3 * j)).Interior.Color = RGB(255 * c, 255 * (1 - c), 0)
Next j
Cells.EntireColumn.AutoFit
End If
End Sub