'necessite d'activer la reference Microsoft ActiveX Data Objects x.x Library
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim Fichier As String, Cible As String, Feuille As String
Dim i As Integer, j As Integer
Fichier = ThisWorkbook.Path & '\\fichierB.xls'
Feuille = 'Feuil1$' 'attention a ne pas oublier le '$'
Set Cn = New ADODB.Connection
Cn.Open 'Provider = Microsoft.Jet.OLEDB.4.0;' & _
'data source=' & Fichier & ';' & _
'extended properties=''Excel 8.0;'''
Cible = 'SELECT * FROM [' & Feuille & '];'
Set Rs = New Recordset
Rs.Open Cible, Cn, adOpenKeyset, adLockOptimistic
For j = 2 To Range('A65536').End(xlUp).Row 'nb de lignes à transferer
With Rs
.AddNew
For i = 0 To 4 'nb de colonnes a transferer ( index 1ere colonne =0)
.Fields(i) = Cells(j, i + 1)
Next i
.Update
End With
Next j
Rs.Close
Cn.Close