repartition aleatoir sans dedeoublon

Private Sub CommandButton1_Click()
Dim i&, j&, k&, L&, M&, azar&
Dim TabTemp(), T As Variant
Application.ScreenUpdating = False
M = 0
With Sheets("Feuil1")
    For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        ReDim TabTemp(0 To 12)
        For j = 0 To 12
            TabTemp(j) = .Cells(i, j + 1)
        Next j
        M = M + 1
        With Cells(Rows.Count, 2).End(xlUp)
            .Offset(1, -1).Value = M
            .Offset(1, 0).Resize(1, 13) = TabTemp
        End With
        For L = 1 To 5
            Randomize
            For k = LBound(TabTemp) + 1 To UBound(TabTemp)
                azar = Int(k * Rnd)
                If azar <> 0 Then
                    T = TabTemp(k)
                    TabTemp(k) = TabTemp(azar)
                    TabTemp(azar) = T
                End If
            Next k
            M = M + 1
            With Cells(Rows.Count, 2).End(xlUp)
                .Offset(1, -1).Value = M
                .Offset(1, 0).Resize(1, 13) = TabTemp
            End With
        Next L
    Next i
End With
Application.ScreenUpdating = True
End Sub

Private Sub CommandButton1_Click()
Dim A&, j&, k&, L&, M&, N&, Nbr&
Dim TR(), TD As Variant, T As Variant, LstCol&
Application.ScreenUpdating = False
M = 0: LstCol = 14: Nbr = 6
With Sheets("Feuil1")
    TD = .Range(.Cells(2, 1), .Cells(Rows.Count, LstCol - 1).End(xlUp)).Value
End With
ReDim TR(1 To UBound(TD, 1) * Nbr, 1 To LstCol)
For j = 1 To UBound(TD, 1)
    M = M + 1
    TR(M, 1) = M
    For L = 2 To LstCol
        TR(M, L) = TD(j, L - 1)
    Next L
    For L = 1 To Nbr - 1
        M = M + 1
        TR(M, 1) = M
        For N = 2 To LstCol
            TR(M, N) = TR(M - 1, N)
        Next N
        Randomize
        For k = 3 To LstCol
            Do
                A = Int((k * Rnd) + 1)
            Loop While A < 3
            T = TR(M, k)
            TR(M, k) = TR(M, A)
            TR(M, A) = T
        Next k
    Next L
Next j
With Sheets("Resultat")
    .Range(.Cells(2, 1), .Cells(Rows.Count, LstCol).End(xlUp).Offset(1, 0)).ClearContents
    .Cells(2, 1).Resize(M, LstCol) = TR
End With
Application.ScreenUpdating = True
End Sub