[AccessD] Divide A Table into 4 equal parts and append to a second table

Hi all...
I have built a function that seems to achieve my aims although I feel it
looks a little clunky...

Its purpose is to reduce the data of 4 records in a table (NUMBERS) to a
single record in another table (Table4up) with a view to using that data on
a report 4 up.

Can anyone suggest a better/more efficient way to achieve my aims? The code
as is will not handle less than 9 records and I realise its not finished as
there is no error checking or setting variables to NOTHING but wanted to get
the groups feeling about the efficiency. This code will form the heart of a
new project I am working on and I want it to be the best way possible to do
it.....

Function REnder4UPnew()
Dim Db As Database, Rs As Recordset
Dim RsAdd As Recordset
Dim Nos As String
Dim NoRecs As Long
Dim FourUp As String
Dim Counter As Integer
Dim DElQry As String
Dim ModNo As Integer

DElQry = "DELETE Table4UP.* FROM Table4UP;"
DoCmd.RunSQL DElQry

Nos = "SELECT NUMBERS.* FROM NUMBERS ORDER BY NUMBERS.IDNO;"
FourUp = "SELECT Table4UP.* FROM Table4UP;"

Set Db = CurrentDb
Set Rs = Db.OpenRecordset(Nos)
Set RsAdd = Db.OpenRecordset(FourUp)


With Rs
    .MoveFirst
    .MoveLast
NoRecs = .RecordCount

ModNo = NoRecs Mod 4

Select Case ModNo
Case 0
    NoRecs = Int(.RecordCount / 4)
Case 1
    NoRecs = Int(.RecordCount / 4) + 1
Case 2
    NoRecs = Int(.RecordCount / 4) + 1
Case 3
    NoRecs = Int(.RecordCount / 4) + 1
End Select

Counter = 0

....MoveFirst

While Not .EOF Or .BOF
Counter = Counter + 1

Select Case Counter
Case 1 To NoRecs
        RsAdd.AddNew
        RsAdd!sequence = Counter
        RsAdd!Pos1 = ![idno]
        RsAdd.Update

Case (NoRecs + 1) To (NoRecs * 2)
    If Counter = (NoRecs + 1) Then
        RsAdd.MoveFirst
        RsAdd.Edit
        RsAdd!Pos2 = ![idno]
        RsAdd.Update
        RsAdd.MoveNext
    Else
        RsAdd.Edit
        RsAdd!Pos2 = ![idno]
        RsAdd.Update
        RsAdd.MoveNext
    End If

Case ((NoRecs * 2) + 1) To (NoRecs * 3)
    If Counter = ((NoRecs * 2) + 1) Then
        RsAdd.MoveFirst
        RsAdd.Edit
        RsAdd!Pos3 = ![idno]
        RsAdd.Update
        RsAdd.MoveNext
    Else
        RsAdd.Edit
        RsAdd!Pos3 = ![idno]
        RsAdd.Update
        RsAdd.MoveNext
    End If

Case ((NoRecs * 3) + 1) To (NoRecs * 4)
    If Counter = ((NoRecs * 3) + 1) Then
        RsAdd.MoveFirst
        RsAdd.Edit
        RsAdd!Pos4 = ![idno]
        RsAdd.Update
        RsAdd.MoveNext
    Else
        RsAdd.Edit
        RsAdd!Pos4 = ![idno]
        RsAdd.Update
        RsAdd.MoveNext

    End If
End Select

....MoveNext
Wend
End With
Select Case ModNo
Case 1
        RsAdd.Edit
        RsAdd!Pos4 = 9997
        RsAdd.Update
        RsAdd.MoveNext
        RsAdd.Edit
        RsAdd!Pos4 = 9998
        RsAdd.Update
        RsAdd.MoveNext
        RsAdd.Edit
        RsAdd!Pos4 = 9999
        RsAdd.Update

 Case 2
         RsAdd.Edit
        RsAdd!Pos4 = 9997
        RsAdd.Update
        RsAdd.MoveNext
        RsAdd.Edit
        RsAdd!Pos4 = 9998
        RsAdd.Update

 Case 3
         RsAdd.Edit
        RsAdd!Pos4 = 9997
        RsAdd.Update
 End Select



End Function

Thanks In Anticipation

Tom Keatley