Need help with Update in VBA

I have a database which receives periodic updates in the form of a table that is downloaded and sent to me. Previously there has been an extensive process (in Excel) that is needed in order to get this table ready to be used in the database and I am working to automate as much of this as possible. I am stuck with the following process:
The table arrives with one record per position code and indicates how many positions are authorized. I need to expand the table so that there is one position record to be linked with one person record. What I want to do is create a Do Until..Loop process that copies the first record (lets say it has authorization for 3 positions) and decrements a position counter and then updates a field called 'PosNbr' of the NEW record so that I end up with two more records for this position that are numbered 2 and 1. That way I can create a concatenated ident field for tracking position 1 of 3, etc.

I have been able to do each of the processes (copy, append and update) separately, but have not been able to combine them so that they loop correctly. My code is below. I have some lines remarked out while I am testing.

Thanks for any help you can provide.


Private Sub Updatetbl_Click()

Dim PNbr As Integer
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim varBookmark As Variant


'These next 3 lines are used to create the new TDA table,
'insert the records where there is only 1 position, delete those
'records from the original, and update the PosNbr field to 1

'DoCmd.OpenQuery "1-qryMakeNewTDA-singlepos"
'DoCmd.OpenQuery "2-qryMakeNewTDA-delsinglepos"
'DoCmd.OpenQuery "3-qryMakeNewTDA-updatePosNbr"

Set db = CurrentDb

DoCmd.OpenForm "frm0513TDA", acFormDS, , , acFormEdit

Set rs = db.OpenRecordset("0513TDA", dbOpenDynaset)

rs.MoveFirst

'Do Until rs.EOF = True


PNbr = (DLookup("[PosNbr]", "0513TDA"))
'If rs.EOF Then Exit Do

'bookmark this record for returning in the loop
varBookmark = rs.Bookmark


'DoCmd.SetWarnings False


'rs.MoveNext

'Loop through this record copying and pasting until
'PNbr = 1
Do While PNbr <> 1
DoCmd****nCommand acCmdSelectRecord

DoCmd****nCommand acCmdCopy
DoCmd****nCommand acCmdPasteAppend

rs.MoveLast
DoCmd****nCommand acCmdSelectRecord

PNbr = PNbr - 1
rs.Edit
'Update PosNbr to the PNbr value
rs!PosNbr = PNbr
rs.Update

DoCmd****nCommand acCmdSaveRecord

'return to the bookmarked record
rs.Bookmark = varBookmark
If PNbr = 1 Then Exit Do
Loop


'Loop

DoCmd.Close acForm, "frm0513TDA"
rs.Close
Set rs = Nothing
End Sub