After it has found all of the matching fields, the program loops through the source Recordset. For each record, it creates a new record in the destination Recordset and copies the values from the source fields into the destination fields.

Private Sub cmdCopy_Click()
Dim db As DAO.Database
Dim rs_fr As DAO.Recordset
Dim rs_to As DAO.Recordset
Dim fields_fr() As DAO.Field
Dim fields_to() As DAO.Field
Dim field_fr As DAO.Field
Dim field_to As DAO.Field
Dim num_fields As Integer
Dim i As Integer
Dim num_copied As Long

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

    ' This example empties the "to" table before starting.
    ' You may or may not want this in a real application.
    db.Execute "DELETE FROM " & txtTableTo.Text

    ' Open the tables.
    Set rs_fr = db.OpenRecordset(txtTableFrom.Text, _
        dbOpenTable)
    Set rs_to = db.OpenRecordset(txtTableTo.Text, _
        dbOpenTable)

    ' Find the fields that match in the two tables.
    num_fields = 0
    For Each field_fr In rs_fr.fields
        ' Get the matching field in the "to" table.
        On Error Resume Next
        Set field_to = rs_to.fields(field_fr.Name)
        If Err.Number <> 0 Then Set field_to = Nothing
        On Error GoTo 0
        If Not (field_to Is Nothing) Then
            ' Save the matching fields.
            num_fields = num_fields + 1
            ReDim Preserve fields_fr(1 To num_fields)
            ReDim Preserve fields_to(1 To num_fields)
            Set fields_fr(num_fields) = field_fr
            Set fields_to(num_fields) = field_to

            lstFields.AddItem field_fr.Name
        End If
    Next field_fr

    ' Copy the records.
    num_copied = 0
    Do Until rs_fr.EOF
        ' Make a new record.
        rs_to.AddNew

        ' Copy the field values.
        For i = 1 To num_fields
            fields_to(i).Value = fields_fr(i).Value
        Next i
        rs_to.Update

        rs_fr.MoveNext
        num_copied = num_copied + 1
    Loop

    rs_fr.Close
    rs_to.Close
    db.Close

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