Option Explicit

Sub ExcelTabelleNachWordExportieren()

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long

    Dim wdApp As Object
    Dim wdDoc As Object

    Dim aktuelleJobfamilie As String
    Dim aktuelleJobcluster As String
    Dim aktuelleJobrolle As String

    Dim letzteJobfamilie As String
    Dim letzteJobcluster As String
    Dim letzteJobrolle As String

    Dim kurzbeschreibung As String
    Dim skill As String
    Dim skillsGesammelt As String

    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
    Set wdDoc = wdApp.Documents.Add

    For i = 2 To lastRow

        aktuelleJobfamilie = Trim(ws.Cells(i, "B").Value)
        aktuelleJobcluster = Trim(ws.Cells(i, "D").Value)
        aktuelleJobrolle = Trim(ws.Cells(i, "F").Value)
        kurzbeschreibung = Trim(ws.Cells(i, "K").Value)
        skill = Trim(ws.Cells(i, "H").Value)

        If aktuelleJobrolle <> letzteJobrolle And letzteJobrolle <> "" Then
            SchreibeSkills wdDoc, skillsGesammelt
            skillsGesammelt = ""
        End If

        If aktuelleJobfamilie <> letzteJobfamilie Then
            SchreibeAbsatz wdDoc, aktuelleJobfamilie, "Überschrift 1"
            letzteJobfamilie = aktuelleJobfamilie
            letzteJobcluster = ""
            letzteJobrolle = ""
        End If

        If aktuelleJobcluster <> letzteJobcluster Then
            SchreibeAbsatz wdDoc, aktuelleJobcluster, "Überschrift 2"
            letzteJobcluster = aktuelleJobcluster
            letzteJobrolle = ""
        End If

        If aktuelleJobrolle <> letzteJobrolle Then
            SchreibeAbsatz wdDoc, aktuelleJobrolle, "Überschrift 3"

            SchreibeAbsatz wdDoc, "Kurzbeschreibung:", "Standard"
            SchreibeAbsatz wdDoc, kurzbeschreibung, "Standard"
            SchreibeAbsatz wdDoc, "", "Standard"

            letzteJobrolle = aktuelleJobrolle
        End If

        If skill <> "" Then
            If skillsGesammelt = "" Then
                skillsGesammelt = skill
            Else
                skillsGesammelt = skillsGesammelt & ", " & skill
            End If
        End If

    Next i

    If skillsGesammelt <> "" Then
        SchreibeSkills wdDoc, skillsGesammelt
    End If

    wdDoc.SaveAs2 ThisWorkbook.Path & "\Jobrollen.docx"

    MsgBox "Word-Datei wurde erstellt:" & vbCrLf & _
           ThisWorkbook.Path & "\Jobrollen.docx"

End Sub


Private Sub SchreibeSkills(ByVal wdDoc As Object, ByVal skillsText As String)

    SchreibeAbsatz wdDoc, "Skills:", "Standard"
    SchreibeAbsatz wdDoc, skillsText, "Standard"
    SchreibeAbsatz wdDoc, "", "Standard"

End Sub


Private Sub SchreibeAbsatz(ByVal wdDoc As Object, ByVal text As String, ByVal formatvorlage As String)

    Dim rng As Object

    Set rng = wdDoc.Content
    rng.Collapse Direction:=0

    rng.InsertAfter text & vbCrLf
    rng.Paragraphs.Last.Range.Style = formatvorlage

End Sub