Insertar registros cuadro combinado

Hola,
Hace unos días me ayudaste mucho por esto te pido otra vez tu ayuda :)
Tengo un formulario llamado Contactes (tabla contactos) que dentro de él hay un subformulario llamado Contactes específics (tabla contactos específics). Estos están relacionados entre si por el campo Empresa. El primero te muestra los datos de la empresa y el segundo los datos de los empleados.
Contactes específics contiene un cuadro combinado que continene los nombres y apellidos de los empleados de la empresa que has seleccionado en Contactes. Cuando seleccionas un nombre se te rellena el resto de formulario con los datos del empleado seleccionado.
El problema es cuando quiero ingresar un nuevo empleado que no estaba en la tabla. El código que utilizo es el siguiente:
-----------------------------------------------------------------------------------------------------------------
Private Sub Cuadro_combinado48_NotInList(NewData As String, Response As Integer)
Dim strUser As String
Dim intI As Integer, strNombre As String, strApellido As String
'Le asigno a strUser el valor NewData
strUser = NewData
'Comprobamos si está en la lista
intI = InStr(strUser, ",")
If intI > 0 Then
strNombre = Trim(Left(strUser, intI - 1))
strApellido = Trim(Mid(strUser, intI + 1))
Else
MsgBox "El empleado introducido no está en la lista.  Para añadirlo como nuevo " & _
"empleado, debes poner el nombre, una coma, y el apellido.", vbCritical, "AVISO"
Response = acDataErrContinue
Me.Cuadro_combinado48 = ""
Exit Sub
End If
'Compruebo otra vez al ponerlo separado con coma si ya existe ya el empleado
If DLookup("IdContacte", "Contactes específics", _
"[Nom] = """ & strNombre & """ AND " & _
"[Cognom] = """ & strApellido & """") Then
MsgBox "Ese empleado ya existe", vbCritical, "YA EXISTE"
strNombre = NewData
Response = acDataErrContinue
'Si no existe
Else
Select Case MsgBox("Vas a insertar el empleado " & strNombre & " " & strApellido & "." _
                   & vbCrLf & "¿Deseas abrir el formulario Empleados para completar el registro?." _
                   & vbCrLf & "Si.- Inserta" _
                   & vbCrLf & "No.- No inserta" _
                   & vbCrLf & "" _
                   , vbYesNo Or vbQuestion Or vbDefaultButton1, "Aviso")
'Si contesta que si
Case vbYes
'Le asigno al combo el Nombre del Empleado
Me.Cuadro_combinado48 = strNombre
' Quito los mensajes de anexar datos
DoCmd.SetWarnings False
'Ejecuto la consulta y le anexo el Nombre y el Apellido
DoCmd.RunSQL " INSERT INTO [Contactes específics] ( Nom, Cognom )VALUES('" & strNombre & "', '" & strApellido & "')"
'Hago un requery al combo para que vuelva a consultar los datos
Me.Cuadro_combinado48.Requery
'Vuelvo a habilitar los avisos
DoCmd.SetWarnings True
'Le asigno strNombre a newdata para que no muestre el mensaje de no está en lista
strNombre = NewData
'Si cancela
Case vbNo
'Borro el valor del combo
Me.Cuadro_combinado48 = ""
End Select
End If
If IsNull(DLookup("IdContacte", "Contactes específics", _
"[Nom] = """ & strNombre & """ AND " & _
"[Cognom] = """ & strApellido & """")) Then
Response = acDataErrContinue
Else
Response = acDataErrAdded
End If
Exit Sub
Response = acDataErrDisplay
End Sub
-----------------------------------------------------------------------------------------------------------------
Con este código se me crea un nombre y apellido de empleado nuevo y se me guarda en la tabla Contactes específics. El problema es que el resto de campos del subformulario no se guardan.
¿Sabes qué código o que me falla?
Muchísimas gracias por tu ayuda y dedicarme tu tiempo!