Rastgele Benzersiz Liste Oluşturma

[ojibu]

ekteki daha önce site de olan tek kişilik rastgele seçimi çoklu alt alta liste oluşturma şeklinde nasıl yapabiliriz. ben biraz kod ekledim ama alt alta olmuyor
Function uret(son)
basla:
sayi = Int((son * Rnd) + 1)
If sayi > son Then GoTo basla
uret = sayi
End Function

Sub SEÇ()

Dim sayfaad, i

sayfaad = "LİSTE"
'ActiveSheet.Unprotect
ADET = InputBox("Kaç kişi için liste oluşturayım?")
For i = 1 To ADET
son = Cells(Rows.Count, 1).End(3).Row

If WorksheetFunction.CountBlank(Range("D2" & son)) = 0 Then

MsgBox "Secilecek kişi kalmadı", vbCritical
Exit Sub
End If

basla:
sira = uret(son - 1) + 1
If Cells(sira, "d") = "" Then
[g5] = Cells(sira, "C")
Cells(sira, "D") = "*"
son = Cells(Rows.Count, 1).End(3).Row
Worksheets("SEÇİM").Cells(son, 1).Value = Cells(sira, "C")

Else
GoTo basla:
End If



Next i
'ActiveSheet.Protect
End Sub

 

[ojibu]

yardımcı olacak birisi yokmu acaba

 

[muratboz06]

Dosyanızı dosya.tc ye yüklerseniz, bakabilirim. Ne yapmak istediğiniz hakkında daha açıklayıcı bilgi veriniz. Sorunuzu anlamadım.

 

[ojibu]

hocam sitede rastgele listeden seçim yapan programın bir kişi değilde kaç kişi diye sorduğunda aldığı cevaba göre başka bir sayfada alt alta liste oluşturması. benim yaptığım da boşluklar oluyor ekte dosya sunulmuştur.

 

[bmutlu966]

Böyle bir şey mi istiyorsunuz.

 

[ojibu]

evet tşk ederim. diğer sayfaya yazdırmayı ben ayarlarım