Hallo,

da ich kein Outlook intalliert habe, kann ich es nicht testen. So langsam gehen mir die Ideen aus, diese eine habe ich noch (von der ich mir aber nicht viel erhoffe):

Sub auswahlNachOutlook()
'
' Beispiel-Funktion - Markieren - und autoamtisch eintragen in Outlook
' 2016, www.stallwanger.net
'
   Dim StartDatum As Date
   Dim Dauer As Long
   Dim Beschreibung As String
   Dim Nachricht As String
   Dim Ort As String
     
    'Daten aus der Zeile der aktiven Zelle entnehmen
    StartDatum = CDate(Cells(ActiveCell.Row, 3).Value)
    Dauer = Cells(ActiveCell.Row, 4).Value
    Beschreibung = Cells(ActiveCell.Row, 5).Value
    Nachricht = Cells(ActiveCell.Row, 6).Value
    Ort = Cells(ActiveCell.Row, 7).Value
   
    
  'Nach Outlook
    
   lvOutlook StartDatum, Dauer, Beschreibung, Nachricht, Ort
End Sub
  
Public Function lvOutlook(ByVal outDate As Date, outDauer As Long, outSubject As String, outBody As String, outlocation As String) As Boolean
    'Hier beginnen die Termine
    'On Error GoTo ErrOutLook       wenn es gut läuft, dann kannst du diese Fehlerbehandlung aktivieren (ich bin kein Freund davon)
    Set OutApp = CreateObject("Outlook.Application")
    Set apptOutApp = OutApp.CreateItem(1) 'olAppointmentItem)
    With apptOutApp
        'Datum und Uhrzeit - als Start-Uhrzeit 8:00 -
        .Start = cdate(DateSerial(Year(outDate), Month(outDate), Day(outDate)) + TimeSerial(8, 0, 0)) 'Es kann auch eine andere Uhrzeit festgelegt werden.
        'Termininfo
        .Subject = outSubject
        'oder der Betreff steht in der Spalte rechts von den Terminen
        .Location = outlocation '         'Ort
        .Duration = outDauer   ' 1 Std. = "60" Dauer in Minuten
        'Erinnerung setzen in Outlook (hier inaktiv)
        '
        .ReminderPlaySound = True
        'Erinnerung wiederholen
        .ReminderSet = True
        'Termin speichern
        .Save
    End With
    Set apptOutApp = Nothing
    Set OutApp = Nothing
    lvOutlook = True
    MsgBox "Termin an Outlook übertragen."
    Exit Function
 
ErrOutLook:
    Set apptOutApp = Nothing
    Set OutApp = Nothing
    lvOutlook = False
    MsgBox "Termin konnte in Outlook nicht eingetragen werden.  Fehler:" & Err.Description
End Function