Ajuste Codigo

Este é um sistema de sorteio de bingo e verifiquei que nao esta correto a geracao de cartelas. Seria possível alguem verificar este codigo e verificar o seguinte: as pedras de 1 a 20 devem sair para a coluna B, de 21 a 40 para coluna I, de 41 a 60 para acoluna N, de 61 a 80 para coluna G e de 81 a 100 na coluna O.

Como nao conheco de programacao , penso que o problema pode estar no codigo a seguir, porem nao consigo corrigí-lo.

José Silvio

Sub FillCardsSTD(lngCardCount As Long, Optional blnFreeSpace As Boolean = False)

On Error GoTo Err_FillCards_Click

Dim myDB As Database
Dim rsCards As Recordset
Dim intCellCounter As Integer
Dim lngCardCounter As Long
Dim fldCurrentField As Field

Set myDB = CurrentDb()
Set rsCards = myDB.OpenRecordset("tblCards", dbOpenDynaset)
'---Main

'clear cards table
DoCmd.SetWarnings False
DoCmd.OpenQuery "qrdClearCards"
DoCmd.SetWarnings True

'Set up outer loop to iterate the once for each card specified in txtNumCards
For lngCardCounter = 1 To lngCardCount
rsCards.AddNew
rsCards!cardno = lngCardCounter
'setup inner loop to iterate across the current record and fill with selected values
Set fldCurrentField = rsCards.Fields(0) 'cell 0 = cardno and is the card sequence number
fldCurrentField.Value = lngCardCounter
For intCellCounter = 1 To 25 'the rest of the cells
Set fldCurrentField = rsCards.Fields(intCellCounter)
Select Case intCellCounter
Case 1, 6, 11, 16, 21 'the B column
fldCurrentField.Value = FindRandom_TSB("", "tblB", "CellContents")
Case 2, 7, 12, 17, 22 'the I column
fldCurrentField.Value = FindRandom_TSB("", "tblI", "CellContents")
Case 3, 8, 13, 18, 23 'the N column
If Not intCellCounter = 13 Then
fldCurrentField.Value = FindRandom_TSB("", "tblN", "CellContents")
ElseIf blnFreeSpace Then
fldCurrentField.Value = "AtivoAccess"
Else
fldCurrentField.Value = FindRandom_TSB("", "tblN", "CellContents")
End If
Case 4, 9, 14, 19, 24 'the G column
fldCurrentField.Value = FindRandom_TSB("", "tblG", "CellContents")
Case 5, 10, 15, 20, 25 'the O column
fldCurrentField.Value = FindRandom_TSB("", "tblO", "CellContents")
Case Else
End Select
Next 'Card field
'save/commit new record before moving to next row
rsCards.Update
'clear used flags in Cell Contents table
DoCmd.SetWarnings False
DoCmd.OpenQuery "qruSetUsedtoFalseB"
DoCmd.OpenQuery "qruSetUsedtoFalseI"
DoCmd.OpenQuery "qruSetUsedtoFalseN"
DoCmd.OpenQuery "qruSetUsedtoFalseG"
DoCmd.OpenQuery "qruSetUsedtoFalseO"
DoCmd.SetWarnings True
Next 'Card record
'---Clean up
Set rsCards = Nothing
Set myDB = Nothing

Exit_FillCards_Click:
Exit Sub

Err_FillCards_Click:
MsgBox Err.Description
Resume Exit_FillCards_Click

End Sub