Option Explicit
Sub AjoutContact()
Dim olApp As Object, olItem As Object, i&
Set olApp = CreateObject("Outlook.Application")
For i = 2 To [A65536].End(xlUp).Row
Set olItem = olApp.CreateItem(2)
With olItem
.HomeAddressCountry = Cells(i, 1)
.HomeAddressPostalCode = Cells(i, 2)
.HomeAddressCity = Cells(i, 3)
.FirstName = Cells(i, 4)
.HomeAddressStreet = Cells(i, 5)
.Email1Address = Cells(i, 6)
.Save
End With
Next
End Sub