Next the program loops through all of the records in the source table. For each record, it creates a new record in the destination table and loops over the source table's fields, copying their values into the corresponding destination table fields.

Private Sub cmdCopy_Click()
Dim db As DAO.Database
Dim dest_field_index() As Integer
Dim td_src As TableDef
Dim td_dst As TableDef
Dim field_src As Field
Dim field_dst As Field
Dim i As Integer
Dim criterion As String
Dim rs_src As DAO.Recordset
Dim rs_dst As DAO.Recordset
Dim num_copied As Integer

    ' Open the database.
    Set db = DBEngine.Workspaces(0).OpenDatabase( _
        txtDatabase.Text, ReadOnly:=False)

    ' Find the tables.
    Set td_src = db.TableDefs(txtTableSource.Text)
    Set td_dst = db.TableDefs(txtTableDest.Text)

    ' Find the common fields.
    ReDim dest_field_index(0 To td_src.Fields.Count - 1)
    For i = 0 To td_src.Fields.Count - 1
        ' Get the source field.
        Set field_src = td_src.Fields(i)

        ' Find the matching destination field.
        On Error Resume Next
        Set field_dst = td_dst.Fields(field_src.Name)
        If Err.Number <> 0 Then
            On Error GoTo 0
            dest_field_index(i) = -1
            Err.Clear
        Else
            On Error GoTo 0
            dest_field_index(i) = field_dst.OrdinalPosition _
                - 1
        End If
    Next i

    ' Open the Recordsets.
    Set rs_src = db.OpenRecordset(txtTableSource.Text, _
        dbOpenDynaset)
    Set rs_dst = db.OpenRecordset(txtTableDest.Text, _
        dbOpenDynaset)

    ' Copy the records.
    criterion = txtCriterion.Text
    num_copied = 0
    rs_src.FindFirst criterion
    Do Until rs_src.NoMatch
        num_copied = num_copied + 1
        rs_dst.AddNew
        For i = 0 To td_src.Fields.Count - 1
            If dest_field_index(i) >= 0 Then
                rs_dst.Fields(dest_field_index(i)).Value = _
                    rs_src.Fields(i).Value
            End If
        Next i
        rs_dst.Update

        ' Get the next matching record.
        rs_src.FindNext criterion
    Loop

    ' Clean up.
    rs_src.Close
    rs_dst.Close
    db.Close

    MsgBox "Copied " & num_copied & " records"
End Sub