aynı satıra kayıt sorunu

[cobanoglu]

her kayıt butonuna bastığımda aynı yere kayıt yapıyor
yani en son boş satıra geçmiyor ne yapabilirim bi yardım edermisiniz lütfen



Private Sub CommandButton1_Click()
On Error Resume Next

If ad.Value = "" Then
MsgBox "Personelin adını Yazmadınız", vbExclamation, "Eksik Bilgi Girişi"
ad.SetFocus
Exit Sub
End If
son = Application.CountA(Sheets("veri").Columns("a")) + 7

With Sheets("Veri")

.Cells(son, 2) = ad.Value
.Cells(son, 3) = görev.Value
.Cells(son, 4) = derece.Value
.Cells(son, 5) = sicil.Value
.Cells(son, 6) = esicil.Value
.Cells(son, 7) = PERTC.Value

.Cells(son, 8) = esicil.Value
.Cells(son, 9) = tc1.Value
.Cells(son, 10) = isim2.Value
.Cells(son, 11) = tc2.Value
.Cells(son, 12) = isim3.Value
.Cells(son, 13) = tc3.Value
.Cells(son, 14) = isim4.Value
.Cells(son, 15) = tc4.Value
.Cells(son, 16) = isim5.Value
.Cells(son, 17) = tc5.Value
End With
'#########
ActiveWorkbook.Save
yanıt = MsgBox("Personel Bilgileri Kaydedildi.Yenit Kayıt Yapmak İstiyor musunuz?", vbYesNo, "KAYIT TAMAM")
If yanıt = vbYes Then
sicil = ""
esicil = ""
ad = ""
görev = ""
derece = ""
isim1 = ""
isim2 = ""
isim3 = ""
isim4 = ""
isim5 = ""
tc1 = ""
tc2 = ""
tc3 = ""
tc4 = ""
tc5 = ""
PERTC = ""
Exit Sub
End If

Unload Me

End Sub

 

[alibal]

Kandi Kaydet kodlarımı gönderdim.
KOYU RENKLE işaretli satır işineze yarayacaktır umarım.

Sub Kaydet()
If Cells(8, "B") > "" And Cells(8, "C") > "" And Cells(8, "D") > "" And Cells(8, "E") > "" Then
    Worksheets("Veri Tabanı").Select
    With Worksheets("Kayıt_Ekle")
        [B]sonsatir = [B507].End(3).Row + 1   'B sütünunda Dolu olan en son satırın bir sonrasını belirledik[/B]
        For x = 2 To 28
             Cells(sonsatir, x) = UCase$(Trim(.Cells(8, x)))  ' Girilen kayıt bilgilerini kırp ve BÜYÜK harfe dönüştür 
        Next
    End With
    Call SIRALA
    Worksheets("Kayıt_Ekle").Select
Else: MsgBox "Lütfen Kayıt Bilgilerini (en az ilk 6 alanı) giriniz..."
End If
End Sub

 

[Orion1]

Merhaba.

son = Application.CountA(Sheets("veri").Columns("a")) + 7

Yukarıdaki satırı aşağıdaki satırla değiştirip deneyiniz.

son = Application.CountA(Sheets("veri").Columns("B")) + 7

Not:arda arda yazabilmesi için yukarıdaki koda göre B sütununda ilk 6 satırın boş olması gerekiyor.

 

[cobanoglu]

hala 36. satırdan başlıyor

örneği ekliyorum ben yapamadım yardımcı olursanız gerçekten çok sevineceğim

 

[cobanoglu]

bu form ları ben excell veb tr den aldım ama kendi veri tabanıma uygulamayı başaramadım

 

[Orion1]

Merhaba.
Aşağıdaki şekilde deneyiniz.

son = Application.CountA(Sheets("veri").Columns("B")) + 6

 

[cobanoglu]

ilk 6 satırı sildim düzeldi ilgi ve alakanıza teşekkürler