Botão de Registro em um Formulário (Copia dados de um form para Tabela)

 Pessoal preciso resolver mais uma questão quanto um projeto que estou executando que funciona da seguinte forma:

Eu criei um formulário não vinculado que registra dados para serem enviadas para uma tabela, já consegui enviar os dados, mas ocorre um erro no código quando tento cadastrar a segunda vez no form, ele impede cadastro em que alguma dos campos linhas de ID e nomes estão vazias.

Eu preciso de um solução que registre somentes os campos preenchidos e não registre os campos nomes vazios.

Segue material anexo.



Private Sub BotaoRegistrar_Click()

Dim db1 As Database, db2 As Database, rs1 As DAO.Recordset, rs2 As DAO.Recordset, rs3 As DAO.Recordset

If MsgBox("Confirma Transferencia?", vbYesNo + vbQuestion, "CONFIRMAR") = vbYes Then

Set db1 = CurrentDb

Set rs1 = db1.OpenRecordset("Registros", dbOpenTable)

With rs1


.AddNew

![EvData] = Me.Data
![EvIndicador] = Me.ltxResultadoPesquisa1.Column(0, Linha)
![EvNota] = Me.Nota.Column(0, Linha)
![EvPonto] = Me.Nota.Column(1, Linha)
![ID] = Me.TxtID1
![NOME] = Me.TxtNome1

.Update

.AddNew

![EvData] = Me.Data
![EvIndicador] = Me.ltxResultadoPesquisa1.Column(0, Linha)
![EvNota] = Me.Nota.Column(0, Linha)
![EvPonto] = Me.Nota.Column(1, Linha)
![ID] = Me.TxtID2
![NOME] = Me.TxtNome2
.Update


.AddNew

![EvData] = Me.Data
![EvIndicador] = Me.ltxResultadoPesquisa1.Column(0, Linha)
![EvNota] = Me.Nota.Column(0, Linha)
![EvPonto] = Me.Nota.Column(1, Linha)
![ID] = Me.TxtID3
![NOME] = Me.TxtNome3
.Update


.AddNew

![EvData] = Me.Data
![EvIndicador] = Me.ltxResultadoPesquisa1.Column(0, Linha)
![EvNota] = Me.Nota.Column(0, Linha)
![EvPonto] = Me.Nota.Column(1, Linha)
![ID] = Me.TxtID4
![NOME] = Me.TxtNome4
.Update


.AddNew

![EvData] = Me.Data
![EvIndicador] = Me.ltxResultadoPesquisa1.Column(0, Linha)
![EvNota] = Me.Nota.Column(0, Linha)
![EvPonto] = Me.Nota.Column(1, Linha)
![ID] = Me.TxtID5
![NOME] = Me.TxtNome5
.Update


.AddNew

![EvData] = Me.Data
![EvIndicador] = Me.ltxResultadoPesquisa1.Column(0, Linha)
![EvNota] = Me.Nota.Column(0, Linha)
![EvPonto] = Me.Nota.Column(1, Linha)
![ID] = Me.TxtID6
![NOME] = Me.TxtNome6
.Update



.AddNew

![EvData] = Me.Data
![EvIndicador] = Me.ltxResultadoPesquisa1.Column(0, Linha)
![EvNota] = Me.Nota.Column(0, Linha)
![EvPonto] = Me.Nota.Column(1, Linha)
![ID] = Me.TxtID7
![NOME] = Me.TxtNome7
.Update


.AddNew

![EvData] = Me.Data
![EvIndicador] = Me.ltxResultadoPesquisa1.Column(0, Linha)
![EvNota] = Me.Nota.Column(0, Linha)
![EvPonto] = Me.Nota.Column(1, Linha)
![ID] = Me.TxtID8
![NOME] = Me.TxtNome8
.Update

.AddNew

![EvData] = Me.Data
![EvIndicador] = Me.ltxResultadoPesquisa1.Column(0, Linha)
![EvNota] = Me.Nota.Column(0, Linha)
![EvPonto] = Me.Nota.Column(1, Linha)
![ID] = Me.TxtID9
![NOME] = Me.TxtNome9
.Update


.AddNew

![EvData] = Me.Data
![EvIndicador] = Me.ltxResultadoPesquisa1.Column(0, Linha)
![EvNota] = Me.Nota.Column(0, Linha)
![EvPonto] = Me.Nota.Column(1, Linha)
![ID] = Me.TxtID10
![NOME] = Me.TxtNome10
.Update
End With


MsgBox "Transferencia confirmada.", vbOKOnly + vbInformation, "Concluído"

End If
End Sub

Boa tarde,
Private Sub BotaoRegistrar_Click()
Dim rs1 As DAO.Recordset
Dim I As Integer, I2 As Integer, Preenchidos As Boolean

For I = 1 To 10
If Len("" & Me("TxtNome" & I)) > 0 Then
Preenchidos = True
End If
Next

If Not Preenchidos Then MsgBox "Não tem dados para transferir.": Exit Sub

If MsgBox("Confirma Transferência?", vbYesNo + vbQuestion, "CONFIRMAR") = vbNo Then Exit Sub

Set rs1 = CurrentDb.OpenRecordset("Registros", dbOpenTable)

With rs1
I2 = 0
For I = 1 To 10
If Len("" & Me("TxtNome" & I)) > 0 Then
I2 = I2 + 1
.AddNew
![EvData] = Me.Data
![EvIndicador] = Me.ltxResultadoPesquisa1.Column(0, Linha)
![EvNota] = Me.Nota.Column(0, Linha)
![EvPonto] = Me.Nota.Column(1, Linha)
![ID] = Me("TxtID" & I)
![NOME] = Me("TxtNome" & I)
.Update
End If
Next
End With
Set rs1 = Nothing
MsgBox "Transferência confirmada." & vbCr & vbCr & I2 & " registos transferidos.", vbOKOnly + vbInformation, "Concluído"

Me.Data = Null
Me.Nivel = Null
Me.ltxResultadoPesquisa1 = Null
Me.tlSource = Null
Me.Nota = Null

For I = 1 To 10
Me("TxtID" & I) = Null
Me("TxtNome" & I) = Null
Next


End Sub

Funcionou muito bem... Obrigado!

Marque o botão Resolvido, na zona inferior direita do formulário