Access - speeding up VBA code

Public Sub TransposeImportTbl()
Dim rs As DAO.Recordset, rs1 As DAO.Recordset
Dim i As Integer, j As Integer, fldArr()
 
On Error GoTo Err_out
 
'These variables take values off the Form
Dim Local_ID As String
Local_ID = Forms![Bulk Data Import Form]!LocationID_combo.Value
Dim File_ID As String
File_ID = Forms![Bulk Data Import Form]!FileID_combo.Value
Dim DataGroup_ID As String
DataGroup_ID = Forms![Bulk Data Import Form]!DataGroupID_combo.Value
 
Set rs = CurrentDb.OpenRecordset("IMPORT")  
Set rs1 = CurrentDb.OpenRecordset("Data_Intermediate") 
 
If rs.EOF Or rs.BOF Then
    MsgBox "no records"
    Exit Sub
End If
rs.MoveFirst
    For i = 0 To rs.Fields.Count - 1
        ReDim Preserve fldArr(i)
        fldArr(i) = rs.Fields(i).Name
    Next
 
Do Until rs.EOF
    For j = 2 To UBound(fldArr)
        If Not rs(fldArr(j)).Value Then  ' if not null
           With rs1
                .AddNew
                ![Date] = rs("Date")
                !Time = rs("Time")
                ![Data] = rs.Fields(fldArr(j))
                !DeterminantID = rs.Fields(fldArr(j)).Name
                !FileID = File_ID
                !LocationID = Local_ID
                !DataGroupID = DataGroup_ID
                .Update
            End With
            Else
        End If
    Next
    rs.MoveNext
Loop
 
Err_out:
Exit Sub
 
End Sub