Codgio VBA

¡ Hola !
Tengo el siguiente codigo:
Public Function EjecutarTablaDetalles( _
ByVal num_tabla As Integer, _
ByVal consulta As String, _
Optional ByVal filtro As String = "" _
) As Boolean
On Error GoTo Errores
Call SysCmd(acSysCmdInitMeter, "Exportando a Word: " & consulta, 100)
DoCmd.Hourglass True

Dim rs As DAO.Recordset
Dim field As DAO.field
Dim tabla As word.Table
Dim ultima_fila As word.Row, nueva_fila As word.Row
Dim celda As word.Cell
Dim campo As String, valor As String

If filtro <> "" Then consulta = "SELECT * FROM " & consulta & " WHERE " & filtro
Set rs = CurrentDb.OpenRecordset(consulta, dbOpenForwardOnly)
Set tabla = documento_word.Tables(num_tabla)

If rs.BOF And rs.EOF Then
'Nada
Else
Do Until rs.EOF
Set ultima_fila = tabla.Rows(tabla.Rows.Count)
Set nueva_fila = tabla.Rows.Add
For Each celda In ultima_fila.Cells
'Duplicar la última fila en la nueva
campo = celda.Range.Text
campo = Left(campo, Len(campo) - 2) 'Eliminar vbCrLf del final
nueva_fila.Cells(celda.ColumnIndex).Range.Text = campo
'Poner los valores
'For Each field In rs.Fields
'If 0 <> InStr(LCase(field.Name), "importe") Then
'valor = Format(Nz(rs(field.Name), 0), "#,##0.00")
'Else
'valor = rs(field.Name) & ""
'End If
'campo = Replace(campo, "[" & field.Name & "]", valor)
'Next
'celda.Range.Text = campo
Next

'Call SysCmd(acSysCmdUpdateMeter, rs.PercentPosition) 'Fallas porque es dbOpenForwardOnly
rs.MoveNext
Loop
End If

'Borrar la última fila
tabla.Rows(tabla.Rows.Count).Delete

EjecutarTablaDetalles = True
Salida:
Call SysCmd(acSysCmdRemoveMeter)
DoCmd.Hourglass False
Exit Function
Errores:
MsgBox Err.Description, vbCritical, "EjecutarTablaDetalles"
Resume Salida
End Function

Me crea en la tabla de detalles las filas necesarias pero en cada fila me repite los mismos datos, en el ejemplo los datos son númericos y en mi base de datos son tipo texto.

Cuál puede ser el error en el código?