Prob lors de l'export excel vers access

Bonjour,
j'ai un prob en fait lors du transport d'excel vers access.
en effet en exécutant ce code, les tableaux d'excel vont être créer mais lors de l'ouverture d'access pour lire ces tables un message apparaitera en disant la requête doit avoir au moins un champ de destination.
svp aidez moi


Private Sub mnu_exp_acc_Click()
'Lancement de l'exportation vers access

On Error Resume Next
Nb_Rec_Total = 0
Dim rep As Variant
Dim req2 As String
Rec_cour = 0

CreateNewMDB Cmd_Save.FileTitle, Jet4x
mypath = Cmd_Save.FileName

If cnn.State = 1 Then cnn.Close
cnn.Open Connection_Base(ext, ComDlg.FileName, ComDlg.FileTitle)

If NewBase.State = 1 Then NewBase.Close
connstr = "Driver={Microsoft Access Driver (*.mdb)};Dbq=" & mypath
NewBase.Open connstr
For x = 0 To LstTableArr.ListCount - 1

'Création de la table ainsi que des champs
If RS.State = 1 Then RS.Close
If rs2.State = 1 Then rs2.Close
req1 = "Create table " & LstTableArr.List(x)
RS.Open req1, NewBase
If RS.State = 1 Then RS.Close
RS.Open "select * from [" & LstTableArr.List(x) & "]", cnn

LBL_traitement_table.Visible = True
LBL_traitement_table.Caption = "Traitement de " & LstTableArr.List(x)
If P_Bar.Value = P_Bar.Max Then
P_Bar.Value = 0
Else
P_Bar.Value = P_Bar.Value + 5
End If


For i = 0 To RS.Fields.Count - 1
'Création des champs de la table
If rs2.State = 1 Then RS.Close
req2 = "ALTER TABLE [" & LstTableArr.List(x) & "] ADD t_" & CStr(RS.Fields(i).Name) & " varchar(200)"

rs2.Open req2, NewBase
If rs2.State = 1 Then rs2.Close

Next i

If rs2.State = 1 Then rs2.Close
rs2.CursorType = adOpenKeyset
rs2.LockType = adLockOptimistic
rs2.Open "[" & LstTableArr.List(x) & "]", NewBase, , , adCmdTable
Nb_Lignes = 0
Do While RS.EOF = False
Nb_Lignes = Nb_Lignes + 1
RS.MoveNext
Loop
RS.MoveFirst
P_Bar.Max = Nb_Lignes
P_Bar.Value = 0

Rec_cour = 0

Do While RS.EOF = False
rs2.AddNew

For z = 0 To RS.Fields.Count - 1
rs2(z) = RS(z).Value
Nb_Rec_Total = Nb_Rec_Total + 1
Next z
rs2.Update

RS.MoveNext
Rec_cour = Rec_cour + 1
P_Bar.Value = P_Bar.Value + 1

Loop
Next x


repertoire.Caption = repertoire.Caption & Left(Cmd_Save.FileName, Len(Cmd_Save.FileName) - Len(Cmd_Save.FileTitle))
frame_go_export.Visible = False
Frame_Log.Visible = True

Me.MousePointer = 0
etat_exp.Visible = False
P_Bar.Value = 0
P_Bar.Visible = False
LBL_traitement_table.Caption = ""
LBL_traitement_table.Visible = False
End Sub