MdlBaglanti.baglanti
Set rs = CreateObject("adodb.recordset")
    Sorgu = "select * from AcikFisler where not isnull(Kimlik)"
   
   Call baglanti
 
   
     On Error Resume Next
    rs.Open Sorgu, baglan, 1, 2
 
 
  rs.Close ' seti sonlandırır
baglan.Close ' bağlantıyı sonlandır
    Set baglan = Nothing ' Hafızayı Boşaltır
    Set rs = Nothing
 
End Sub

Dim id As Long
    id = Me.id.Caption ' OpenFisler tablosundaki id
    
    ' KapalıFisler tablosuna ekleme yapmak için INSERT INTO SQL sorgusu oluşturun
    Dim sql As String
    sql = "INSERT INTO KapalıFisler (id, diger_alanlar) " & _
          "SELECT id, diger_alanlar FROM OpenFisler " & _
          "WHERE id=" & id
    
    ' Access veritabanına bağlanın
    Dim cnn As New ADODB.Connection
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Veritabanım.accdb;"
    
    ' SQL sorgusunu çalıştırın
    cnn.Execute sql
    
    ' Kaynakları temizleyin
    cnn.Close
    Set cnn = Nothing
    
    MsgBox "Kayıt başarıyla taşındı!"
End Sub

Sub tasi()
Dim id As Long
Dim xEkle As String
Set baglan = CreateObject("adodb.connection")
Call baglanti
    id = Me.LblSozlesmeNo.Caption ' OpenFisler tablosundaki id
  
    ' KapalıFisler tablosuna ekleme yapmak için INSERT INTO SQL sorgusu oluşturun
 
    xExle = "INSERT INTO KapalıFisler (Kimlik, HareketTipi, Guntipi, UrunBarkodu, UrunCinsi, UrunAdi, UrunRengi, Aksesuar, KuaforHizmeti, GelinAdi, GelinTelefon, DamatAdi, DamatTelefon, Tarih, Ay, Yil, Borc, Odeme, Kalan, Açıklama, FisTarihi, GeriadeTarihi) " & _
          "SELECT Kimlik, HareketTipi, Guntipi, UrunBarkodu, UrunCinsi, UrunAdi, UrunRengi, Aksesuar, KuaforHizmeti, GelinAdi, GelinTelefon, DamatAdi, DamatTelefon, Tarih, Ay, Yil, Borc, Odeme, Kalan, Açıklama, FisTarihi, GeriadeTarihi FROM AcikFisler " & _
          "WHERE Kimlik=" & id
  
  baglan.Execute xEkle
 
    baglan.Close
    Set baglan = Nothing
  
    MsgBox "Kayıt başarıyla taşındı!"
End Sub