Excel hücresinden acceseye aktarımda kısa yol

[ikikan]

Arkadaşlar Kırmızı ile işaretli olan kodun daha kısa bir yolu yokmudur,
bu şekilde 300 veri girmem gerekince sorun olacak !

Sub AccesseKaydet2()
Call baglanti1
Dim i As Integer
Set rs = CreateObject("adodb.recordset")
With Sheets("VVV")
rs.Open "select * from sil", con, 1, 3
rs.addnew
rs.fields(1).Value = Range("A1").Value
rs.fields(2).Value = Range("A2").Value
rs.fields(3).Value = Range("A3").Value
rs.fields(4).Value = Range("A4").Value
rs.fields(5).Value = Range("A5").Value
rs.Update

End With
MsgBox "Kayıtlar veritabanına aktarıldı", vbInformation
con.Close

End Sub

 

[Murat OSMA]

Bu şekilde bir deneyiniz;

for i = 1 to rs.fields.count
    rs.fields(i).value = .cells(1, i)
Next i

 

[ikikan]

Bu şekilde bir deneyiniz;

for i = 1 to rs.fields.count
    rs.fields(i).value = .cells(1, i)
Next i

Murat bey hata veriyor.?

 

[ikikan]

En sonunda

Teşekürler Murat bey verdiğiniz kodu geliştirince oldu

Private con As Object, rs As Object
Sub baglanti1()
Set con = CreateObject("adodb.connection")
con.Open "provider=microsoft.jet.oledb.4.0;data source = " & ThisWorkbook.Path & "\RPDATA.mdb"
End Sub

Sub AccesseKaydet2()
Call baglanti1
On Error Resume Next
Dim i As Integer
Set rs = CreateObject("adodb.recordset")
Set Sh = Sheets("VVV")
rs.Open "select * from sil", con, 1, 3
rs.addnew
For i = 1 To rs.fields.Count
rs.fields(i).Value = Sh.Cells(i, 1).Value
rs.Update
Next i

MsgBox "Kayıtlar veritabanına aktarıldı", vbInformation
con.Close
End Sub

 

[Murat OSMA]

Rica ederim, iyi günler.