Copier cellules au hasard

[guy72]

Bonjour,

En AZ20:AZ42, j'ai 12 lettres entrecoupées d'espace.
Je voudrais simplement copier ces lettres au hasard en F20:F42 mais avec le format (couleur des lettres et des cellules).
Y a t'il une meilleure solution que de copier les cellules une par une ?

Merci de votre aide.

 

[bqtr]

Re : Copier cellules au hasard

Bonjour Guy,

Teste ceci:

Sub AleaCell()

Dim TabFin(), Tablo(1 To 2, 1 To 23)
Dim k As Byte, x As Integer, m As Byte, l As Byte, j As Byte, h As Byte
Dim temp1, temp2
Randomize

For k = 1 To 23
  Tablo(1, k) = Rnd
  Tablo(2, k) = k + 19
Next

For k = 1 To 23
  For x = 2 To 23
     If Tablo(1, k) > Tablo(1, x) Then
        temp1 = Tablo(1, x)
        temp2 = Tablo(2, x)
        Tablo(1, x) = Tablo(1, k)
        Tablo(2, x) = Tablo(2, k)
        Tablo(1, k) = temp1
        Tablo(2, k) = temp2
     End If
  Next
Next

m = 0
For l = LBound(Tablo, 2) To UBound(Tablo, 2)
   ReDim Preserve TabFin(m)
   TabFin(m) = Tablo(2, l)
   m = m + 1
 Next

h = 20
For j = LBound(TabFin) To UBound(TabFin)
 Cells(TabFin(j), 52).Copy Cells(h, 6)
 h = h + 1
Next
   
End Sub

Cela copie la plage AZ20:AZ42 de façon aléatoire en F20:F42

A+

 

[guy72]

Re : Copier cellules au hasard

Bonjour bqtr
D'accord, ça me copie la plage AZ20:AZ42 de façon aléatoire en F20:F42.
Mais comme je le dis dans mon message, ces lettres sont entrecoupées d'espaces.
La phrase entrecoupées d'espaces, nest peut-être pas très explicite, ce que j'apelle espace, c'est une cellules entre les lettres.
Ce que je souhaiterais c'est garder quand même une cellule vide entre chaque lettre.
Cordialement.

 

[bqtr]

Re : Copier cellules au hasard

Re,

Alors essaye ca:

Sub AleaCell()

Dim TabFin(), Tablo(1 To 2, 1 To 23), TabRecopi()
Dim k As Byte, x As Integer, m As Byte, l As Byte, j As Byte, h As Byte, s As Byte, d As Byte
Dim temp1, temp2
Randomize

For k = 1 To 23
  Tablo(1, k) = Rnd
  Tablo(2, k) = k + 19
Next

For k = 1 To 23
  For x = 2 To 23
     If Tablo(1, k) > Tablo(1, x) Then
        temp1 = Tablo(1, x)
        temp2 = Tablo(2, x)
        Tablo(1, x) = Tablo(1, k)
        Tablo(2, x) = Tablo(2, k)
        Tablo(1, k) = temp1
        Tablo(2, k) = temp2
     End If
  Next
Next

m = 0
For l = LBound(Tablo, 2) To UBound(Tablo, 2)
   ReDim Preserve TabFin(m)
   TabFin(m) = Tablo(2, l)
   m = m + 1
 Next

s = 0
For j = LBound(TabFin) To UBound(TabFin)
 If Cells(TabFin(j), 52) <> "" Then
   ReDim Preserve TabRecopi(s)
   TabRecopi(s) = TabFin(j)
   s = s + 1
 End If
Next

h = 20
For d = LBound(TabRecopi) To UBound(TabRecopi)
 Cells(TabRecopi(d), 52).Copy Cells(h, 6)
 h = h + 2
Next
   
End Sub

A+

 

[guy72]

Re : Copier cellules au hasard

Bonsoir bqtr

Ok ça fonctionne parfaitement.
Excuse-moi de ne pas avoir bien expliqué mes espaces.
Merci de ton aide.
Cordialement
Guy