Satir eklemede kayıt yapmaya yardım

[fatih34]

Forumdaki hocalarımın yardımlarıyla iş yerinde kullanmak üzere bir çalışma yaparak azda olsa bu işi öğrenmek istiyorum.
Örnek dosyamda bulunan verilere bul komutuyla erişip ekleme yapmak istediğim satıra geliyorum ve satır ekle deyince seçilmiş olan satırın üstüne boş bir satır açıyor.

Sorum: Öncelikle eklenen satırın üstünde değil bir altına satır eklemesi
eklenen satıra da Useformda bulunan verileri girerek kayıt yapmak

 

[hamitcan]

Kodları, aşağıdakiler ile değiştirin. Kaydet butonu için yazdığım kodları, bu kodlara bakarak çoğaltın

Dim sat As Long
Private Sub cmdBUL_Click()
Sheets("Sayfa1").Select
    Dim bak As Range
    For Each bak In Range("T2:T" & WorksheetFunction.CountA(Range("T2:T65000")))
        If bak.Text = TextBox71.Text Then
            bak.Select
TextBox1.Text = ActiveCell.Offset(0, -18).Text
TextBox2.Text = ActiveCell.Offset(0, -16).Text
TextBox71.Text = ActiveCell
TextBox3.Text = ActiveCell.Offset(0, -17).Text
TextBox4.Text = ActiveCell.Offset(0, -15).Text
TextBox5.Text = ActiveCell.Offset(0, 5).Text
TextBox6.Text = ActiveCell.Offset(0, -13).Text
TextBox7.Text = ActiveCell.Offset(0, 7).Text
TextBox8.Text = ActiveCell.Offset(0, 8).Text
TextBox10.Text = ActiveCell.Offset(0, -19).Text

On Error Resume Next
adres1 = ActiveWindow.RangeSelection.Address
a = InStr(Trim(adres1), ":")
If a = 0 Then
sat = ActiveWindow.Selection.Row + 1
Else
sat = Range(Mid(adres1, a + 1, 15)).Row
End If
b = MsgBox("satır eklemek istiyormusunuz. ?", vbYesNo + vbInformation, " uyarı")
If b = vbYes Then
Rows(sat & ":" & sat).Insert Shift:=x2Up
End If
 

Exit Sub
        End If
    Next bak
    MsgBox "Aradığınız Kayıt Bulunamadı"
    
End Sub

Private Sub CommandButton1_Click()
Cells(sat, "t") = TextBox71.Text 'Esas No
Cells(sat, "v") = TextBox20.Text ' Sicil
'...
'...
End Sub