Kodu Revize Etmek İçin Yardım

[BedriA]

Arkadaşlar,

Aşağıdaki kod ile E8 hücresinden başlayarak textboxlardaki verileri sırayla E9, E10, E11, E12, E13 hücrelerine; bir sonraki veriyi de E14'ten başlayarak aynı şekilde aktarmak istiyorum. Ancak bu kod ile sürekli ikinci veriyi ilk verinin üzerine yazıyor.

Yardımcı olur musunuz?

Private Sub CommandButton20_Click()
  If TextBox11.Text <> "" Then
            
                        Son_Dolu_Satir = Sheets("test20").Range("A65536").End(3).Row
                        If WorksheetFunction.CountIf(Sheets("test20").Range("E1:E" & Son_Dolu_Satir), TextBox11.Text) > 0 Then
MsgBox "Bu soru daha önce kağıda atıldı.", vbCritical
GoTo 20
End If
                        Bos_Satir = Son_Dolu_Satir + 1
                        Sheets("test20").Range("E" & Bos_Satir).Value = _
                                             Application.WorksheetFunction.Max(Sheets("test20").Range("E:E")) + 1
                                             
                       
                        Sheets("test20").Range("E" & Bos_Satir).Value = TextBox11.Text
                        Sheets("test20").Range("E" & Bos_Satir + 1).Value = TextBox6.Text
                        Sheets("test20").Range("E" & Bos_Satir + 2).Value = TextBox7.Text
                        Sheets("test20").Range("E" & Bos_Satir + 3).Value = TextBox8.Text
                        Sheets("test20").Range("E" & Bos_Satir + 4).Value = TextBox9.Text
                        Sheets("test20").Range("E" & Bos_Satir + 5).Value = TextBox10.Text
                      
                        Sheets("test20").Select
                        MsgBox "Soru havuza atıldı.", vbInformation, "Yeni bir soru ekleyin."
                        Workbooks("SINAVMATİK").Save
                        
                        For i = 6 To 11
                       Controls("TextBox" & i).Text = ""
                      
                       
                       Next i
   
                Else
                    GoTo 5
                End If
          
    Exit Sub
5
    MsgBox "İstenen verileri eksiksiz girdiğinizden emin olduktan sonra tekrar deneyiniz.", vbExclamation, "Kontrol"
20:



End Sub

 

[BedriA]

Private Sub CommandButton20_Click()
  If TextBox11.Text <> "" Then
            
                        Son_Dolu_Satir = Sheets("test20").Range("E65536").End(3).Row
                        If WorksheetFunction.CountIf(Sheets("test20").Range("E1:E" & Son_Dolu_Satir), TextBox11.Text) > 0 Then
MsgBox "Bu soru daha önce kağıda atıldı.", vbCritical
GoTo 20
End If
                        Bos_Satir = Son_Dolu_Satir + 1
                        Sheets("test20").Range("E" & Bos_Satir).Value = _
                                             Application.WorksheetFunction.Max(Sheets("test20").Range("E:E")) + 1
                                             
                       
                        Sheets("test20").Range("E" & Bos_Satir).Value = TextBox11.Text
                        Sheets("test20").Range("E" & Bos_Satir + 1).Value = TextBox6.Text
                        Sheets("test20").Range("E" & Bos_Satir + 2).Value = TextBox7.Text
                        Sheets("test20").Range("E" & Bos_Satir + 3).Value = TextBox8.Text
                        Sheets("test20").Range("E" & Bos_Satir + 4).Value = TextBox9.Text
                        Sheets("test20").Range("E" & Bos_Satir + 5).Value = TextBox10.Text
                      
                        Sheets("test20").Select
                        MsgBox "Soru havuza atıldı.", vbInformation, "Yeni bir soru ekleyin."
                      
                        
                        For i = 6 To 11
                       Controls("TextBox" & i).Text = ""
                      
                       
                       Next i
   
                Else
                    GoTo 5
                End If
          
    Exit Sub
5
    MsgBox "İstenen verileri eksiksiz girdiğinizden emin olduktan sonra tekrar deneyiniz.", vbExclamation, "Kontrol"
20:



End Sub

Yukarıdaki kod ile hallettim. Ancak şunu yapamadım: E67 hücresine de veri girdikten sonra artık veri girişini engellesin ve "Diğer sütuna geçiniz." uyarısı versin istiyorum.

 

[BedriA]

If Sheets("test20").[e67] <> "" Then
MsgBox "Diğer sütuna geçiniz."
Exit Sub
End If

Arkadaşlar sorun çözüldü.
Yukarıdaki kodun başına bu iki satır eklenince artık veri girişine izin vermiyor.

 

[YUSUF44]

Siz kendiniz zaten "E67 doluysa veri girişine izin vermesin" demişsiniz. Normal değil mi girişe izin vermemesi?

"yan sütuna geçiniz" uyarısı bu işlemin manuel olacağını belirtiyor, yani kullanıcı yan sütuna geçmeli, bu durumda koddan yapmasını istediğiniz nedir?

 

[BedriA]

Siz kendiniz zaten "E67 doluysa veri girişine izin vermesin" demişsiniz. Normal değil mi girişe izin vermemesi?

"yan sütuna geçiniz" uyarısı bu işlemin manuel olacağını belirtiyor, yani kullanıcı yan sütuna geçmeli, bu durumda koddan yapmasını istediğiniz nedir?

Sorunu çözdüm, aslında onu belirtmek istedim son mesajda.

Teşekkür ederim ilginiz için.