Kura'da Eşit Şans

[ALTINYAYLA]

Günaydın
Arkadaşlar facebookta bir hemşehri grubum var. Grubun üyelerine yönelik bir kitap hediye kampanyası yapacağım.
Gruba üye ekleyen hemşehrilerimize eklediği üye sayısına göre kura şansı verecek bir kod ve düğme lazım. Alakanıza şimdiden teşekkür ederim.

 

[Muhammet Okumuş]

Sub Kura()
Application.ScreenUpdating = False
Range("F:G") = ""
sat = 4
son = Cells(Rows.Count, 1).End(3).Row
For i = 4 To son
a = Cells(i, 2).Value
For j = 1 To a
Cells(sat, 7) = Cells(i, 1).Value
sat = sat + 1
Next j
Next i
son = Cells(Rows.Count, 7).End(3).Row
Range("F4:F" & son) = "=RAND()"
Range("F4:G" & son).Sort Range("F4"), 1
Range("F4:F" & son) = "=ROW(A1)"
Range("F4:F" & son) = Range("F4:F" & son).Value
End Sub

Kodu deneyiniz.