Excel Takım Dağıtma

[enjloezz]

Öncelikle iyi akşamlar,
Ben bir turnuvada dağıtma işlemi yapmak istiyorum fakat bulamadım ekteki dosyada takım adlarını yazdığım zaman karışık olarak dağıtmasını istiyorum fakat istediğim nasıl yapıldığını öğrenmek hazır yapıp kilitlemezseniz sevinirim

 

[Muhammet Okumuş]

Merhaba

Sub kura()
Application.ScreenUpdating = False
Range("m3:m18") = "=rand()"
Range("m3:m18") = Range("m3:m18").Value
Range("b3:b18").Copy Range("n3")
Range("m3:n18").Sort key1:=Range("m3"), ORDER1:=xlDescending
Range("n3:n6").Copy
Range("e3").PasteSpecial (xlPasteValues)
Range("n7:n10").Copy
Range("e9").PasteSpecial (xlPasteValues)
Range("n11:n14").Copy
Range("e15").PasteSpecial (xlPasteValues)
Range("n15:n18").Copy
Range("e21").PasteSpecial (xlPasteValues)
Range("m3:n18") = ""
Application.CutCopyMode = False
End Sub

kodunu deneyiniz.

 

[enjloezz]

Hocam çok teşekkürler çalıştı çok teşekkür ederim

 

[Muhammet Okumuş]

Dosyayı inceliyiniz.