Например так:

Function CloneRecord(tbl, keyname, key)

CloneRecord = Null

Dim Newkey
Dim kn
Dim rs As Recordset
Dim ds As Recordset
Dim i As Integer, C As Integer

On Error GoTo CloneRecord_Err2
Set rs = pdb.OpenRecordset("SELECT * FROM " & tbl & " WHERE " & keyname & "=" & key, dbOpenDynaset)
C = rs.Fields.Count - 1
kn = Null
For i = 0 To C
If rs.Fields(i).Name = keyname Then
kn = i
Exit For
End If
Next i
If IsNull(kn) Then Exit Function 'Key not found

Set ds = pdb.OpenRecordset(tbl, dbOpenDynaset, dbAppendOnly)

wks.BeginTrans 'action
On Error GoTo CloneRecord_Err
ds.AddNew
For i = 0 To C
If i <> kn Then
ds.Fields(i) = rs.Fields(i)
End If
Next i
Newkey = ds.Fields(kn)
ds.UpDate
wks.CommitTrans

ds.Close
rs.Close
CloneRecord = Newkey
Exit Function

CloneRecord_Err:
wks.Rollback
Exit Function

CloneRecord_Err2:
Exit Function

End Function