Access VBA テーブルレコードを別のテーブルにコピー

Question

###Access VBA にてテーブルのレコードを別のテーブルにコピーする
Accessのフォームに設置したボタンをクリックすると、フォームのレコードソースに設定しているテーブルのチェックボックスがTrueとなっているレコードを別のテーブルに2度コピーする。として、以下のコードを作成してみましたが、Accessが固まってしまいました。
修正できますでしょうか？

  'レコードを保存する
  DoCmd.RunCommand acCmdSaveRecord
  'レコード削除の確認メッセージを表示しない
  DoCmd.SetWarnings False
  'テーブルのデータを全削除する
  Dim SQL As String
  SQL = "DELETE * FROM T02_印刷一覧"
  DoCmd.RunSQL SQL
  'ＰＯＳ一覧テーブルを開く
  Set db = CurrentDb()
  Set rs1 = CurrentDb.OpenRecordset("T01_データ一覧", dbOpenTable)
  Set rs2 = CurrentDb.OpenRecordset("T02_印刷一覧", dbOpenTable)
  ReDim vArray(rs1.RecordCount - 1, 2)
  '最後のレコードまで繰り返す
  Do Until rs1.EOF
    If rs1(3).Value = True Then
      'T02に新しいレコードを作成する
      rs2.AddNew
      'レコード内容をコピーする
      rs2![売上用番号] = rs1![売上用番号]
      rs2![社員番号] = rs1![社員番号]
      rs2![社員名] = rs1![社員名]
      '変更内容をアップグレードする
      rs2.Update
      'T02に新しいレコードを作成する
      rs2.AddNew
      'レコード内容をコピーする
      rs2![売上用番号] = rs1![売上用番号]
      rs2![社員番号] = rs1![社員番号]
      rs2![社員名] = rs1![社員名]
      '変更内容をアップグレードする
      rs2.Update
      '次のレコードに移動する
      rs1.MoveNext
    End If
  Loop
  rs1.Close
  rs2.Close

Answer 1

rs1.MoveNextをEnd Ifの後に移動させてください。