reconstituer une base par alea

Sub RemplissageAleatoire()
Dim ncol%, P1 As Range, P2 As Range, c As Range
Dim lig1 As Range, lig2 As Range, cible
ncol = 5 'à adapter
Set P1 = [A:A].Resize(, ncol) 'à adapter
Set P2 = [G:G].Resize(, ncol) 'à adapter
Application.ScreenUpdating = False
[Vides] = "" 'RAZ de la plage nommée
Randomize
For Each c In [Vides]
  Set lig1 = Intersect(c.EntireRow, P1)
  Set lig2 = Intersect(c.EntireRow, P2)
  Do
    cible = lig1(1, Int(Rnd * ncol) + 1)
  Loop While Application.CountIf(lig2, cible)
  c = cible
Next
End Sub

Sub RemplissageAleatoire()
Dim ncol%, P1 As Range, P2 As Range, c As Range
Dim lig1 As Range, lig2 As Range, cible
ncol = 5 'à adapter
Set P1 = [A1].CurrentRegion.Resize(, ncol) 'à adapter
Set P2 = [G1].Resize(P1.Rows.Count, ncol) 'à adapter
Application.ScreenUpdating = False
If IsError([Vides]) Then _
  P2.SpecialCells(xlCellTypeBlanks).Name = "Vides"
[Vides] = "" 'RAZ de la plage nommée
Randomize
For Each c In [Vides]
  Set lig1 = Intersect(c.EntireRow, P1)
  Set lig2 = Intersect(c.EntireRow, P2)
  Do
    cible = lig1(1, Int(Rnd * ncol) + 1)
  Loop While Application.CountIf(lig2, cible)
  c = cible
Next
End Sub

Sub RemplissageAleatoire()
Dim ncol%, P1 As Range, P2 As Range, t1, t2
Dim i&, j%, lig1, lig2, cible
ncol = 5 'à adapter
Set P1 = [A1].CurrentRegion.Resize(, ncol) 'à adapter
Set P2 = [G1].Resize(P1.Rows.Count, ncol) 'à adapter
Application.ScreenUpdating = False
If IsError([Vides]) Then _
  P2.SpecialCells(xlCellTypeBlanks).Name = "Vides"
[Vides] = "" 'RAZ de la plage nommée
t1 = P1: t2 = P2 'matrices, plus rapides
Randomize
For i = 1 To UBound(t1)
  For j = 1 To ncol
    If t2(i, j) = "" Then
      lig1 = Application.Index(t1, i, 0)
      lig2 = Application.Index(t2, i, 0)
      Do
        cible = lig1(Int(Rnd * ncol) + 1)
      Loop While IsNumeric(Application.Match(cible, lig2, 0))
      t2(i, j) = cible
    End If
Next j, i
P2 = t2 'restitution
End Sub

Do
        cible = lig1(Int(Rnd * ncol) + 1)
      Loop While IsNumeric(Application.Match(cible, lig2, 0))

Sub RemplissageAleatoire()
Dim x, ncol%, P1 As Range, P2 As Range, t1, t2
Dim i&, j%, cible, flag As Boolean, k%
x = Timer
ncol = 5 'à adapter
Set P1 = [A1].CurrentRegion.Resize(, ncol) 'à adapter
Set P2 = [G1].Resize(P1.Rows.Count, ncol) 'à adapter
t1 = P1 'matrice, plus rapide
t2 = Feuil2.[A1].Resize(P2.Rows.Count, ncol) 'RAZ, rapide
Randomize
For i = 1 To UBound(t1)
  For j = 1 To ncol
    If t2(i, j) = "" Then
      Do
        cible = t1(i, Int(Rnd * ncol) + 1)
        flag = False
        For k = 1 To ncol
          If t2(i, k) = cible Then flag = True: Exit For
        Next
      Loop While flag
      t2(i, j) = cible
    End If
Next j, i
P2 = t2 'restitution
MsgBox "Durée " & Format(Timer - x, "0.00 \s")
End Sub