Hallo Christian,

Keine Ursache. Ich sammle so ja auch Erfahrung und erweitere meinen Horizont.
Hier nun der komplette Code. Bitte teste und melde dich bei Bedarf. Ich habe nur Access 2003 und konnte es deshalb nur damit testen.

Gruß Heiko

Option Explicit

Public Sub DatenÜbertragen()
'Aktualisiert die Felder eines Datensatzes in der Access-DB
'für Christian von Heiko am 8.1.2012
'Extras-Verweise: Microsoft Active X Data Objects ... Aktivieren

  'On Error GoTo Fehler
    
  'Hier die Parameter anpassen und die Access-Version auswählen
  '============================================================
  'Const c_strProvider As String = "Microsoft.Jet.OLEDB.4.0;"      'Access 2003
  Const c_strProvider As String = "Microsoft.ACE.OLEDB.12.0;"      'Access 2010 (ungetestet)
  Const c_strDB_Path As String = "C:\... \... .accdb"              'Datenbank
  Const c_strDB_Tbl As String = "Auswertung"                       'Tabelle in der Datenbank
  Const c_strXL_Sheet As String = "Zusammenfassung"                'Excel-Arbeitsblatt mit den Daten
  Const c_strXL_AZ As String = "B10"                               'hier steht das Aktenzeichen
  Const c_strUserID As String = "Admin"
  
  Dim cn As ADODB.Connection
  Dim rs As ADODB.Recordset
  Dim strSQL As String
  Dim strAZ As String
  Dim wks As Excel.Worksheet
  
  'Wie lautet das Aktenzeichen?
  Set wks = ThisWorkbook.Sheets(c_strXL_Sheet)
  strAZ = wks.Range(c_strXL_AZ).Value
      
  'Steht tatsächlich ein Aktenzeichen in der Exceltabelle
  If Len(strAZ) > 0 Then
        
    'Verbindung zur Datenbank
    Set cn = New ADODB.Connection
    cn.Provider = c_strProvider
    cn.Open c_strDB_Path, c_strUserID
    cn.CursorLocation = adUseClient
  
    'Aktenzeichen in der Datenbank suchen und öffnen
    strSQL = "Select Status, Wahrscheinlichkeit, Punkte" & _
             " From " & c_strDB_Tbl & _
             " Where AktZ = '" & strAZ & "'"
    Set rs = New ADODB.Recordset
    With rs
      .ActiveConnection = cn
      .CursorType = adOpenForwardOnly
      .LockType = adLockOptimistic
      .Open strSQL, Options:=adCmdText
              
      If Not .BOF Then  'Gibt es dieses Aktenzeichen in der Datenbank
        If .Supports(adUpdate) Then
          .Fields("Status") = wks.Range("B7").Value
          .Fields("Wahrscheinlichkeit") = wks.Range("B8").Value
          .Fields("Punkte") = wks.Range("B9").Value
          .Update
        Else
        MsgBox "Ich kann die Daten für das Aktenzeichen '" & strAZ & "' nicht übertragen." & vbCrLf & _
               "Kein Datensatz übertragen.", vbExclamation, "Datenübertragen"
        End If
        
      Else
        MsgBox "Das Aktenzeichen '" & strAZ & "' gibt es noch nicht." & vbCrLf & _
               "Kein Datensatz übertragen.", vbExclamation, "Datenübertragen"
      End If
      .Close
    End With
    cn.Close
    
  Else
    MsgBox "Es steht kein Aktenzeichen im Arbeitsblatt '" & c_strXL_Sheet & "' in Zelle '" & c_strXL_AZ & "'.", _
           vbCritical, "Datenübertragen"
  End If

Raus:
  Set wks = Nothing

  If Not rs Is Nothing Then
      If rs.State = adStateOpen Then rs.Close
  End If
  Set rs = Nothing
  
  If Not cn Is Nothing Then
      If cn.State = adStateOpen Then cn.Close
  End If
  Set cn = Nothing
  
  Exit Sub
Fehler:
  MsgBox "Fehler: " & CStr(Err.Number) & " " & Err.Description, vbCritical, "DatenÜbertragen"
  Resume Raus

End Sub