Not sure what you want. I think this will do. It assumes you have the cells
you want in the appointment selected. I can can the code to use an inputbox
to select the cells.

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Time = "08:30AM"
With ActiveCell
For RowOffset = 0 To (Selection.Rows.Count - 1)
Set Appointment = Outlook.CreateItem(1)
Appointment.Location = .Range("a2").Offset(RowOffset, 0) & _
", " & .Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.Subject = .Range("i2").Offset(RowOffset, 0)

Appointment.Start = _
DateAdd("d", 350, .Range("b2").Offset(RowOffset, 0)) & _
" " & Time

Appointment.Body = _
.Range("a2").Offset(RowOffset, 0) & ", " & _
.Range("b2").Offset(RowOffset, 0) & ", " & _
.Range("c2").Offset(RowOffset, 0) & ", " & _
.Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.ReminderPlaySound = True
Appointment.Display
Next RowOffset
End With
'Outlook.quit
'Set Outlook = Nothing
End Sub




"bigproblem" wrote:

How can I copy the command button and macro for multiple rows ?

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Set Appointment = Outlook.CreateItem(1)
Time = "08:30AM"

Appointment.Location = Range("a2") & ", " & Range("d2") & ", " & Range("e2")

Appointment.Subject = Range("i2")

Appointment.Start = DateAdd("d", 350, Range("b2")) & " " & Time

Appointment.Body = Range("a2") & ", " & Range("b2") & ", " & Range("c2") &
", " & Range("d2") & ", " & Range("e2")



Appointment.ReminderPlaySound = True
Appointment.Display

'Outlook.quit
'Set Outlook = Nothing
End Sub
--
problem