Loop og en til højre???

Hej E.

Jeg har følgende kode:

Private Sub sendMoede2()

Dim initialer As Integer
Dim Ang As Integer
Dim StartTid As Long
Dim slutTid As Long


' Finder initialer i hele rangen
Application.Goto Reference:="test"
    Selection.Find(What:="jkmi", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

'Her skal den når der er fundet en (initialer) gå en celle til højre
'men hvor dan går men det?



' Her oprettes mødeindkaldelsen
    Dim appOutlook As Outlook.Application
    Set appOutlook = New Outlook.Application
   
    Dim mail As Outlook.AppointmentItem
    Set mail = appOutlook.CreateItem(olAppointmentItem)
   
    With mail
        .Subject = "Helpdeskvagt"
        .Start = "02,12,02 07:00:00 AM"
        .End = "02,12,02 11:30:00 AM"
        .Display
    End With

End Sub

Det jeg gerne vil have den til er når den har fundet en person men initialerne JKMI (i Excel)så skal den gå en celle til højre og fange indholdet derfra.

Funktionen skal loope indtil at der der ikke finder flere initialer med JKMI i rangen.

Nogle gode forslag?