Option Explicit
Sub NouveauRDV_Calendrier()
Dim myOlApp As New Outlook.Application
Dim MyItem As Outlook.AppointmentItem
Dim Cell As Range
For Each Cell In Range("B3:B" & Range("B100").End(xlUp).Row)
If Cell.Offset(, 5) <> "X" Then
Set MyItem = myOlApp.CreateItem(olAppointmentItem)
With MyItem
.MeetingStatus = olNonMeeting
.Subject = Cell
.Start = Cell.Offset(0, 1)
.Duration = Cell.Offset(0, 3) - Cell.Offset(0, 2) 'minutes
'.Location = Cell.Offset(0, 3)
.Body = Cell.Offset(0, 4)
.Save
'Cell.Offset(, 5) = True
End With
Set MyItem = Nothing
End If
Set MyItem = Nothing
Next Cell
End Sub