Aynı kişiye ait birden fazla kayıt varsa Userformda listbox/listwiev de listelensin

[hsayar]

Aşağıdaki kodalar ile veritabanında gönderme yapılan Vatandaşlık numarası ile kişiye ait tapu bilgileri çalışma sayfasında ilgili alanlara gelmektedir. Ancak istediğim aynı kişiye ait birden fazla tapu kaydı varsa Userformda listbox/listwiev de listelenmesi ve seçilenlerin sıra ile 3,4,5,6,7..... sütunlarına gelmesidir. kodlarda nasıl bir değişiklik yapmalıyım?

Private Sub sbTAPKYTALCOKLU(tcno)
If boolIPTAL = True Then Exit Sub
'NUFUS KAYITLARINI AL

  Dim Baglanti As ADODB.Connection                                                    'ADODB bağlantı değişkeni tanımla
  Dim Kayit1 As ADODB.Recordset                                                       'ADODB kayıt alan değişkeni tanımla
  Dim SQLStr As String                                                                'Sorgulanacak alanlar
  Dim KllDgr                                                                  'Kullanılan satır ve Deger
  
'›››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››
    Range("C13:F17").ClearContents        'Aralıktaki hücrelerin içerisini temizler

  KllDgr = tcno
  intKayNo = 1


KaynakSec:
  Select Case intKayNo
    'Kaynak olarak bu kitabın olduğu klasörde veri tabanı belirt
    Case Is = 1: strVT = "C:\VT\vtADAPRS.xls"
'    Case Is = 2: 
'    Case Is = 3: 
  End Select

'\ Seçilen kaynak mevcut mu?
  If Dir(strVT) = "" Then
    MsgBox strVT & " " & Chr(10) & " Dosyası Bulunamadı.", vbInformation, "Bilgi"
    Exit Sub
  End If


'Sorgulanacak başlıkları ve sorgulanacak kriteri yaz
'TCKİMLİKNO  ADI SOYADI  CEK1_ILCE CEK1_KOY  CEK1_MEVK CEK1_ADA  CEK1_PRS  CEK1_MIKT

basliklar = "TCKİMLİKNO, ADI, SOYADI, CEK_ILCE, CEK_KOY, CEK_MEVK, "
basliklar = basliklar & "CEK_ADA, CEK_PRS, CEK_MIKT "

sayfaadi = "[data$] "
sorgu = "TCKİMLİKNO = " & KllDgr
SQLStr = "SELECT " & basliklar & " FROM " & sayfaadi & " WHERE " & sorgu

'\ Bağlantıyı Kur
Set Baglanti = CreateObject("ADODB.Connection")
    With Baglanti
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Properties("Extended Properties").Value = "Excel 8.0"
        .Properties("Data Source").Value = strVT
        .CursorLocation = adUseServer
        .Mode = adModeReadWrite
        .Open
    End With

    If Err = 0 Then                                     'eğer bağlantıda hata yoksa
        Set Kayit1 = CreateObject("ADODB.Recordset")    'kayıt bağlantısını kur
        With Kayit1
            .ActiveConnection = Baglanti
            .CursorLocation = adUseServer
            .CursorType = adOpenKeyset
            .LockType = adLockOptimistic
            .Source = SQLStr
            .Open
        End With
 '***********************************************************************
'TCKİMLİKNO  ADI SOYADI  CEK1_ILCE CEK1_KOY  CEK1_MEVK CEK1_ADA  CEK1_PRS  CEK1_MIKT

        If Kayit1.RecordCount = 1 Then                      '1 adet kayıt bulundu ise
          Cells(13, "C").Value = Kayit1("CEK_ILCE")          'bulunanları yaz
          Cells(14, "C").Value = Kayit1("CEK_KOY")       '..   ""...
          Cells(15, "C").Value = Kayit1("CEK_MEVK")      '..   ""...
          Cells(16, "C").Value = Kayit1("CEK_ADA") & "/" & Kayit1("CEK_PRS")
          Cells(17, "C").Value = Kayit1("CEK_MIKT")    '..   ""...
        ElseIf Kayit1.RecordCount > 1 Then                      '1 adet kayıt bulundu ise
          MsgBox "Birden fazla TAPU KAYDI bulunmaktadır!"
        Else
            If intKayNo <= 1 Then
              intKayNo = intKayNo + 1
              GoTo KaynakSec
            Else
              MsgBox "Aradığınız TAPU KAYDI  Bulunamadı.", vbInformation, "Bilgi"       'uyarı ver
              'tckno = KllDgr
              'UserForm1.Show                                                      'kayıt eklemek için user forma geç
            End If
        End If
    Else                                                        'bağlantıda hata varsa


sonNFS:
    MsgBox "Bağlantı Hatası.Kontrol Ediniz", vbInformation, "Bilgi" 'uayrı ver
End If

'\ Bağlantıyı kapat
If CBool(Kayit1.State And adStateOpen) = True Then Kayit1.Close '?
Set Kayit1 = Nothing    'değişkeni hafızadan sil
If CBool(Baglanti.State And adStateOpen) = True Then Baglanti.Close '?
Set Baglanti = Nothing  'değişkeni hafızadan sil

End Sub