aşağıdaki kodları modüle ekler misiniz?
dikdörtgenin kodu

Sub DikdörtgenKöşeleriYuvarlatılmış1_Tıkla()

rastgeleTestCol

End Sub

ana fonksiyon kodu

Sub rastgeleTestCol()

't1 = Now

Dim SonStr As Long

Dim Secim(0 To 3)



Set Sht = ThisWorkbook.Sheets(Sayfa4.ComboBox1.Value)

SonStr = Sht.Cells(Sht.Rows.Count, "A").End(xlUp).Row

If SonStr < 2 Then Exit Sub

HdfSyf = IIf(Sayfa4.OptionButton1 = True, Sayfa4.OptionButton1.Caption, Sayfa4.OptionButton2.Caption)

Hdf = IIf(Sayfa4.OptionButton1 = True, True, False)

Set HdfSht = ThisWorkbook.Sheets(HdfSyf)

HdfSht.Cells.Clear

SoruSay = Int(Sayfa4.ComboBox2)



Set SozlukColl = New Collection

'hy____________________________Sözcükler için satır seçme

    For x = 2 To SonStr

             SozlukColl.Add x 'Collectiona değer atama

    Next x

AltSnr = 1

For Soru = 1 To SoruSay '

UstSnr = SozlukColl.Count

SonStr = HdfSht.Cells(HdfSht.Rows.Count, "A").End(xlUp).Row + 1

    For x = 0 To 3 'Rasgele 4 kelime için satır seçme

        UstSnr = SozlukColl.Count

        Randomize

        KelimSira = Int((UstSnr - AltSnr + 1) * Rnd + AltSnr)

        Secim(x) = KelimSira

        SozlukColl.Remove (KelimSira) 'seçilen satırı silme

    Next x

        Randomize

        Dogru = Int((3 - 0 + 1) * Rnd + 0) 'Esas kelimeyi seçme

        HdfSht.Cells(SonStr, 1) = Soru

    For x = 0 To 3

        HdfSht.Cells(SonStr, x + 3) = Sht.Cells(SozlukColl(Secim(x)), -1 - Hdf + 2) 'Şıklar

    Next x

        HdfSht.Cells(SonStr, 2) = Sht.Cells(SozlukColl(Secim(Dogru)), Hdf + 2) 'Esas kelime

Next Soru

'Debug.Print Sht.Name, HdfSht.Name, SoruSay

't2 = Now

'Debug.Print t1, t2, DateDiff("s", t1, t2)

End Sub

---

hata kontrolleri eklenmedi mesela olmayan sayfayı seçerseniz hata verir yada combolar boş ise...