Private Function copy_cell(rownum As Integer, rsZiel As Recordset, rsQuelle As Recordset, Index As Integer) As String
Dim err_txt As String
On Error GoTo ErrorMessage:
copy_cell = ""
rsZiel.Fields(Index+1) = pcrsQuelle.Fields(Index)
Exit Function
ErrorMessage:
err_txt = "Zeile " & Str(rownum )
err_txt = err_txt & " [" & rsZiel.Fields(Index +1).Name & "] "
err_txt = err_txt & "<" & Err.Description & ">"
copy_cell = err_txt
Resume Next
End Function
private sub copy_table(TabelleZiel As String, TabelleQuelle As String)
Set rsZiel = dbx.OpenRecordset(TabelleZiel)
Set rsQuelle = dbx.OpenRecordset(TabelleQuelle)
zahl = 0
Do While Not rsQuelle.EOF
zahl = zahl + 1
rsZiel.AddNew
rsZiel.Fields(0) = zahl
For Index = 0 To rsZiel.Fields.Count - 1
s = copy_cell(zahl, rsZiel, rsQuelle, Index)
Next Index
rsZiel.Update
rsQuelle.MoveNext
loop