Datensatz aus Access Tabelle1 in Tabelle 2 kopiere

Sub Archiv_AuftraglisteKunden_Lesen()
Dim i As Byte
Rem  Access
With Uf_Exe.Controls(Uf_Exe.ComboVar)
VarOBez = .List(.ListIndex, 1)
VarANr = .List(.ListIndex, 2)
VarAStatus = .List(.ListIndex, 4)
End With
Rem: öffne Access DB
StartStammdatei
rs_daten.Index = "ID"        'Archiv auslesen
rs_daten.Seek (VarANr)
rs_daten2.Index = "ID"  'Aktiver Auftrag
Do Until rs_daten.EOF
If rs_daten.Fields("AuftagNr") = VarANr Then
Dim trans
For i = 1 To 21
rs_daten2.Fields(i) = rs_daten.Fields(i).Value
Next i
End If
Loop
Rem: Schliesse Access DB
DB_Close
End Sub

Sub StartStammdatei()
nochmals:
AcsDbName = "D:\Projekt\AuftraglisteKunden.mdb"
AcsDbSource = "DatenTransfer"
AcsDbSource2 = "DatenTransferAktiv"
On Error GoTo schliessen
pfad = ActiveWorkbook.Path & AcsDbName
Rem: öffnet Access DB
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & pfad
Set rs_daten = New ADODB.Recordset  'Datenblatt 1
With rs_daten
.ActiveConnection = conn
.CursorType = adOpenKeyset
.CursorLocation = adUseServer
.LockType = adLockOptimistic
.Source = AcsDbSource
.Open Options:=adCmdTableDirect
End With
Set rs_daten2 = New ADODB.Recordset  'Datenblatt 2
With rs_daten2
.ActiveConnection = conn
.CursorType = adOpenKeyset
.CursorLocation = adUseServer
.LockType = adLockOptimistic
.Source = AcsDbSource2
.Open Options:=adCmdTableDirect
End With
Exit Sub
schliessen:
Rem: Schliesse Access DB
DB_Close
GoTo nochmals
End Sub

Sub DB_Close()
On Error Resume Next
rs_daten.Update             'Actualisiert Access DB
rs_daten2.Update
rs_daten.Close              ' Schliesst Datenblatt Access
rs_daten2.Close
Set rs_daten = Nothing
Set rs_daten2 = Nothing
conn.Close                  'Schliesst Datei Access
Set conn = Nothing
End Sub