Aynı veriyi iki ayrı tabloya yazma

[1ndependent]

Merhabalar,

Aşağıdaki kod ile verilerimi Access üzerinde Montaj tablosu üzerine yazdırıyorum. Ancak Bu kod içinde bir değişiklik yaparak aynı verileri Montaj_havuz tablosunada yazdırmasını nasıl sağlayabilirim?
Şimdiden teşekkürler.

Private Sub CommandButton1_Click()
    Dim yol As String, Dosya As String
    Dim baglan As New ADODB.Connection, ks As New ADODB.Recordset
    yol = ThisWorkbook.path & "\"
    Dosya = "Veritabani.mdb"
    
    Set baglan = New ADODB.Connection
    baglan.Open "Provider=Microsoft.ace.OLEDB.12.0;Data Source=" & yol & Dosya & ";"

    Set ks = New ADODB.Recordset
    
    ks.Open "SELECT * FROM Montaj", baglan, adOpenDynamic, adLockOptimistic
    ks.AddNew
    
    ks("Personel") = TextBox2.Text
    ks("Adet") = TextBox3.Text
    ks("QrKod") = TextBox4.Text
    ks("LotNo") = TextBox5.Text
    ks("Rev") = TextBox6.Text
    ks("Proje") = TextBox7.Text
    ks("Operasyon") = TextBox8.Text
    ks("BaslamaZamani") = TextBox9.Text
    ks("BitisZamani") = TextBox10.Value = "0"
    ks("OperasyonSuresi") = TextBox11.Value = "0"
    ks("DuraklamaSuresi") = TextBox16.Value
    ks("Aciklama") = TextBox12.Text
    ks("Tarih") = TextBox13.Text
    
          
    ks.Update
    TextBox1 = Empty
    TextBox2 = Empty
    TextBox3 = Empty
    TextBox4 = Empty
    TextBox5 = Empty
    TextBox6 = Empty
    TextBox7 = Empty
    TextBox8 = Empty
    TextBox9 = Empty
    TextBox10 = Empty
    TextBox11 = Empty
    TextBox12 = Empty
    TextBox13 = Empty
    TextBox16 = Empty
    
    Set baglan = Nothing
    Set ks = Nothing
    Call goster
    TextBox2.SetFocus
    ListView1.SelectedItem = Nothing
End Sub

 

[1ndependent]

Kendim sordum kendim cevapladım gibi oldu.

Bu şekilde çözdüm.

Dim baglan As ADODB.Connection
Dim ks As ADODB.Recordset, yol As String, Dosya As String, i As Long
Dim ks2 As ADODB.Recordset
If ListView1.SelectedItem Is Nothing Then
    MsgBox "Lütfen bir satır seçiniz." & vbLf & "İşlem Yapılmadı.", vbCritical, "UYARI    "
    Exit Sub
End If
yol = ThisWorkbook.path & "\"
Dosya = "Veritabani.mdb"
Set baglan = New ADODB.Connection
Set ks = New ADODB.Recordset
Set baglan = New ADODB.Connection
Set ks2 = New ADODB.Recordset

baglan.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & Dosya & ";"
ks.Open "select * from [Final_Montaj] where Sıra=" & _
        CLng(ListView1.SelectedItem.Text), baglan, adOpenKeyset, adLockOptimistic

    ks.AddNew
          
    
    ks("Personel") = TextBox2.Text
    ks("Adet") = TextBox3.Text
    ks("QrKod") = TextBox4.Text
    ks("LotNo") = TextBox5.Text
    ks("Rev") = TextBox6.Text
    ks("Proje") = TextBox7.Text
    ks("Operasyon") = TextBox8.Text
    ks("BaslamaZamani") = TextBox9.Text
    ks("BitisZamani") = TextBox10.Value
    ks("OperasyonSuresi") = TextBox11.Value
    ks("DuraklamaSuresi") = TextBox16.Value
    ks("Aciklama") = TextBox12.Text
    ks("Tarih") = TextBox13.Text
    
ks.Update

ks.Close


ks2.Open "select * from Final_Montaj_havuz", baglan, adOpenKeyset, adLockOptimistic

ks2.AddNew

    ks2("Personel") = TextBox2.Text
    ks2("Adet") = TextBox3.Text
    ks2("QrKod") = TextBox4.Text
    ks2("LotNo") = TextBox5.Text
    ks2("Rev") = TextBox6.Text
    ks2("Proje") = TextBox7.Text
    ks2("Operasyon") = TextBox8.Text
    ks2("BaslamaZamani") = TextBox9.Text
    ks2("BitisZamani") = TextBox10.Value
    ks2("OperasyonSuresi") = TextBox11.Value
    ks2("DuraklamaSuresi") = TextBox16.Value
    ks2("Aciklama") = TextBox12.Text
    ks2("Tarih") = TextBox13.Text
    
    ks2.Update


ks2.Close




baglan.Close

Set ks = Nothing: Set baglan = Nothing
ListView1.ListItems.Clear


Call goster
MsgBox "Kaydetme işlemi başarı ile gerçekleşti.", vbOKOnly + vbInformation