[COLOR="DarkSlateGray"][B]Private Sub Codes_Click()
Dim n$
n = InputBox("Combien ?", , 1)
If n <> "" Then
Randomize
toto Val(n), "1234567890", "AB", Me.[A2]
End If
End Sub
Sub toto(n&, v1$, v2$, r As Range)
Dim i&, j&, tmp$, rdo!, sDat(), oColl As New Collection
n = WorksheetFunction.Max(1, WorksheetFunction.Min(n, 5 * Len(v2) * WorksheetFunction.Permut(Len(v1), 4)))
ReDim sDat(1 To n, 1 To 1)
Do
For i = 1 To 4
v1 = Mid$(v1, 1 + Int(Len(v1) * Rnd), 1) & Left$(v1, Int(Len(v1) * Rnd(0))) & Right$(v1, Len(v1) - Int(Len(v1) * Rnd(0)) - 1)
Next i
rdo = Rnd
tmp = Left$(v1, 4)
tmp = Left$(tmp, Int((1 + Len(tmp)) * Rnd)) & Mid$(v2, 1 + Int(Len(v2) * rdo), 1) & Right$(tmp, Len(tmp) - Int((1 + Len(tmp)) * Rnd(0)))
On Error Resume Next
oColl.Add tmp, tmp
If Err.Number = 0 Then j = j + 1: sDat(j, 1) = tmp
On Error GoTo 0
Loop While oColl.Count < n
With r
.Parent.Range(.Cells, .Parent.Cells(.Parent.Rows.Count, 1).End(xlUp)).ClearContents
.Resize(oColl.Count, 1).Value = sDat
End With
End Sub[/B][/COLOR]