Sub CreateConnection() 'Declare and instantiate the connection Dim cnn As ADODB.Connection Dim rs As New ADODB.Recordset Dim arr() As Variant Set cnn = New ADODB.Connection 'Open the connection cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=C:\Documents and Settings\KonKram\Рабочий стол\SQLiteForExcel\ADO\BD-01.accdb;" & _ "Persist Security Info=False" ' MsgBox "Connected via " & cnn.Provider & " OLE DB Provider!", vbInformation rs.CursorType = adOpenKeyset rs.LockType = adLockOptimistic rs.Open "select * from ТОСВ ", cnn MsgBox rs.GetString 'Вывести данные из БД For i = 0 To rs.Fields.Count - 1 shd.Range("A1").Offset(0, i).Value = _ rs.Fields(i).Name Next i rs.MoveFirst Do Until rs.EOF shd.Range("A1").Offset(1, 0).CopyFromRecordset rs Loop 'Поиск значения. Для правильного поиска нужен ПРАВИЛЬНЫЙ Запрос!!! rs.Find "ДебетН = 7650" Do While Not rs.EOF Debug.Print "ДебетН: "; rs.Fields("ДебетН") ' mark = rs.Bookmark rs.Find "ДебетН = 7650", 1, adSearchForward If rs.Fields("ДебетН") = 7650 Then GoTo NEXT_ Loop NEXT_: 'rs.AddNew 'rs.Fields("Счет") = "76" 'rs.Fields("ДебетН") = "7650" 'rs.Fields("ДебетО") = "7650" 'rs.Fields("ДебетК") = "7650" ' 'rs.Fields("КредитН") = "76506" 'rs.Fields("КредитО") = "76505" 'rs.Fields("КредитК") = "76505" 'rs.Update Set rs = Nothing cnn.Close Set cnn = Nothing End Sub