Private sub  PrintStroks()
const Colum&=3
On error goto handle1
Dim rst as recordset, rzd as recordset, KolStrok&, i&, Lastcolumn$
set rst=CurrentDb.OpenRecordset("table", dbOpenSnapshot) ' откуда
If rst.absoluteposition=-1 then exit sub ' если ни одной записи в исходной таблице нет выходим
currentdb.execute "Delete from table1" ' очищаем результирующую таблицу
Set rzd = CurrentDb.OpenRecordset("table1", dbOpenDynaset) ' куда

with rst
.movefirst
  Lastcolumn= .fields(4)
  gosub gosub1 ' копируем заголовок
.movenext
  do until .eof
   for KolStrok=1 to !Count ' копируем нужное количество раз строку 
           Lastcolumn=KolStrok
           gosub gosub1
   next KolStrok
.movenext
Loop
end with
exithere:
rzd.close: rst.close
set rst=nothing: set rzd=nothing

exit sub
gosub1:
rzd.addnew 
for i=0 to Colum
 rzd.fields(i)=rst.fields(i)
next i
rzd.fields(i)=Lastcolumn
rzd.update
return
handle1:
' обработка ошибок
Debug.Print err.Number; Tab; err.Description
resume exithere
end sub