Sub TerminErstellen()
Dim OL As Outlook.Application, Appoint As Outlook.AppointmentItem, ES As Worksheet, WB As Workbook, TP As Worksheet, Tag As Worksheet
Dim intRow As Integer
Dim Startzeit As Date
Dim VarDat As Variant
Dim Teilnehmer As Variant
Set WB = ThisWorkbook
Set TP = WB.Sheets("Terminplanung")
Set Tag = WB.Sheets("Tage")
VarDat = Tabelle2.Range("f1:t1", "F2:v2")
Teilnehmer = VarDat(1, 1) + ";" + VarDat(1, 2) + ";" + VarDat(1, 3) + ";" + VarDat(1, 4) + ";" + VarDat(1, 5) + ";" + VarDat(1, 6) + ";" + VarDat(1, 7) + ";" + VarDat(1, 8) + ";" + VarDat(1, 9) + ";" + VarDat(1, 10) + ";" + VarDat(1, 11)
Anfang = TP.Cells(4, 2).Value
Ende = TP.Cells(4, 3).Value
For intRow = Anfang To Ende
Set OL = New Outlook.Application
Recipient = TP.Cells(3, 2).Value
DayMeeting = TP.Cells(9, 2).Value
StartTime = Tag.Cells(intRow, 4).Value
Start = Tag.Cells(intRow, 1).Value
Startzeit = Tag.Cells(intRow, 2).Value
EndTime = Tag.Cells(intRow, 5).Value
Location = TP.Cells(2, 2).Value
Subject = TP.Cells(3, 2).Value & " am " & Start
Greeting = TP.Cells(7, 2).Value
BodyA = TP.Cells(9, 2).Value & Chr(13) & Chr(13) & "Am: " & Start & " um " & Startzeit & " Uhr " & Chr(13) & "Im: " & TP.Cells(2, 2).Value & " "
BodyB = TP.Cells(11, 2).Value
BodyC = TP.Cells(13, 2).Value
FinishA = TP.Cells(17, 2).Value & Chr(13) & " "
FinishB = TP.Cells(18, 2).Value
Set Appoint = OL.CreateItem(olAppointmentItem)
With Appoint
.MeetingStatus = olMeeting
.RequiredAttendees = Teilnehmer
.Subject = Subject
.Start = StartTime
.End = EndTime
.Location = Location
.AllDayEvent = False
.Body = Greeting & Chr(10) & Chr(10) & BodyA & Chr(10) & Chr(10) & BodyB & Chr(10) & Chr(10) & BodyC & Chr(10) & Chr(10) & FinishA & Chr(10) & FinishB
.Display
End With
Set OL = Nothing
Next intRow
End Sub