caramote13
XLDnaute Nouveau
Bonjour à vous tous
Je voudrais lors de mon tirage que les noms sur trois colonnes ne soit pas identiques face à face comme sur l'exemple en pièce jointe.
Ma Macro ci-dessous
Merci à vous tous par avance.
Pierre![Wink ;) ;)](data:image/gif;base64,R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7)
Je voudrais lors de mon tirage que les noms sur trois colonnes ne soit pas identiques face à face comme sur l'exemple en pièce jointe.
Ma Macro ci-dessous
Merci à vous tous par avance.
Pierre
Code:
Sub Tirage_au_sort()
Dim i As Integer, DerLig As Integer
Application.ScreenUpdating = False
With Sheets("Pour les noms au hasard")
DerLig = .Range("A1048576").End(xlUp).Row
.Range("A2:A" & DerLig).Copy Destination:=.Range("F2")
For i = 2 To DerLig
.Range("E" & i) = Rnd
Next
.Range("E2:F" & DerLig).Sort Key1:=.Range("E2"), Order1:=xlAscending, Header:=xlNo
Range("C4") = .Range("F2")
Range("C5") = .Range("F3")
Range("C6") = .Range("F4")
Range("C7") = .Range("F5")
Range("C8") = .Range("F6")
Range("C9") = .Range("F7")
Range("C10") = .Range("F8")
Range("C11") = .Range("F9")
Range("C12") = .Range("F10")
Range("C13") = .Range("F11")
Range("C14") = .Range("F12")
Range("C15") = .Range("F13")
Range("C16") = .Range("F14")
Range("C17") = .Range("F15")
Range("C18") = .Range("F16")
Range("C19") = .Range("F17")
.Range("E2:F1048576").ClearContents
With Sheets("Pour les noms au hasard")
DerLig = .Range("B1048576").End(xlUp).Row
.Range("B2:B" & DerLig).Copy Destination:=.Range("F2")
For i = 2 To DerLig
.Range("E" & i) = Rnd
Next
.Range("E2:F" & DerLig).Sort Key1:=.Range("E2"), Order1:=xlAscending, Header:=xlNo
Range("D4") = .Range("F2")
Range("D5") = .Range("F3")
Range("D6") = .Range("F4")
Range("D7") = .Range("F5")
Range("D8") = .Range("F6")
Range("D9") = .Range("F7")
Range("D10") = .Range("F8")
Range("D11") = .Range("F9")
Range("D12") = .Range("F10")
Range("D13") = .Range("F11")
Range("D14") = .Range("F12")
Range("D15") = .Range("F13")
Range("D16") = .Range("F14")
Range("D17") = .Range("F15")
Range("D18") = .Range("F16")
Range("D19") = .Range("F17")
.Range("E2:F1048576").ClearContents
With Sheets("Pour les noms au hasard")
DerLig = .Range("C1048576").End(xlUp).Row
.Range("C2:C" & DerLig).Copy Destination:=.Range("F2")
For i = 2 To DerLig
.Range("E" & i) = Rnd
Next
.Range("E2:F" & DerLig).Sort Key1:=.Range("E2"), Order1:=xlAscending, Header:=xlNo
Range("E4") = .Range("F2")
Range("E5") = .Range("F3")
Range("E6") = .Range("F4")
Range("E7") = .Range("F5")
Range("E8") = .Range("F6")
Range("E9") = .Range("F7")
Range("E10") = .Range("F8")
Range("E11") = .Range("F9")
Range("E12") = .Range("F10")
Range("E13") = .Range("F11")
Range("E14") = .Range("F12")
Range("E15") = .Range("F13")
Range("E16") = .Range("F14")
Range("E17") = .Range("F15")
Range("E18") = .Range("F16")
Range("E19") = .Range("F17")
.Range("E2:F1048576").ClearContents
End With
End With
End With
End Sub
Pièces jointes
Dernière édition: