Hallo Christian,

Hier noch etwas für die Nacht :-) Viel Spaß damit wünscht Heiko

1) Den Datentyp Text für 'AktZ' lasse bitte so stehen. So habe ich es auch vermutet und entsprechend den Code gebaut. Natürlich muss die Feldgröße für alle (auch für alle zukünftigen) Aktenzeichen ausreichend groß sein. Und 'AktZ' soll bitte wirklich der Primärschlüssel von "Auswertung' sein. Ist das Schlüssel-Symbol links neben dem Feldnamen zu sehen?

2) Laufzeitfehler 3704 kommt, wenn die Verbindung zur Datenbank geschlossen wurde. Doch genau das prüfe ich doch in der Zeile. Steht es wirklich genau so da?

  If Not cn Is Nothing Then
      If cn.State = adStateOpen Then cn.Close
  End If
  Set cn = Nothing

3) Alles klar. Update bei vorhandenem Aktenzeichen oder neuer Datensatz bei nicht vorhandenem Aktenzeichen. Bitte sehr.

Public Sub DatenÜbertragen()
'Aktualisiert die Felder eines Datensatzes in der Access-DB
'oder legt den Datensatz neu an
'für Christian von Heiko am 10.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 = "Hier kommt Dein Pfad hin>\Testdatenbank.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 = adUseServer
  
    'Aktenzeichen in der Datenbank suchen und öffnen
    strSQL = "Select AktZ,Status,Wahrscheinlichkeit,Punkte" & _
             " From " & c_strDB_Tbl & _
             " Where AktZ = '" & strAZ & "'"
    Set rs = New ADODB.Recordset
    With rs
      .ActiveConnection = cn
      .CursorType = adOpenKeyset
      .LockType = adLockOptimistic
      .Open strSQL, Options:=adCmdText
      
      If .Supports(adUpdate) Then
        If .BOF Then   'wenn es dieses Aktenzeichen in der Datenbank noch nicht gibt
          .AddNew      'neuen Datensatz anlegen und das Aktenzeichen übertragen
          .Fields("AktZ").Value = wks.Range("B10").Value
        End If
        .Fields("Status").Value = wks.Range("B7").Value
        .Fields("Wahrscheinlichkeit").Value = wks.Range("B8").Value
        .Fields("Punkte").Value = 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
      .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.CancelUpdate
        rs.Close
      End If
  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