Hallo Christian,

es freut mich sehr, wenn die dies kleine Programm hilft. Probiere ruhig selber etwas aus. VBA ist nicht so schwer zu erlernen und es gibt gute Bücher und Internetseiten.

Hier der aktualisierte Code.

Viele Grüße
Heiko

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
  Dim blnNeuerDS As Boolean
  Dim strMsgBox As String
  
  '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) And .Supports(adAddNew) 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 = strAZ
          blnNeuerDS = True
        End If
        .Fields("Status").Value = wks.Range("B7").Value
        .Fields("Wahrscheinlichkeit").Value = wks.Range("B8").Value
        .Fields("Punkte").Value = wks.Range("B9").Value
        .Update
        
        'Meldung an user
        If blnNeuerDS Then
          strMsgBox = "Das Aktenzeichen  " & strAZ & " wurde erfolgreich zur DB hinzugefügt."
        Else
          strMsgBox = "Das Aktenzeichen " & strAZ & " wurde aktualisiert."
        End If
        MsgBox strMsgBox, vbInformation, "Daten übertragen"
        
      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