Du kannst das so machen:

Option Explicit

Private Sub umstrukturieren()
Dim rng As Range, tAV, AV, R&, I&, E&, E2&, Uns$()
Dim Out, lV, V, MInd&
Dim SpalteLohntext&, SpalteNamen&, SpalteStunden&
    
    SpalteLohntext = 2
    SpalteNamen = 3
    SpalteStunden = 4
    With ActiveSheet
        Set rng = .Range(.Cells(2, .Columns.Count).End(xlToLeft), .Cells(.Rows.Count, 1).End(xlUp)) 'benutzter Bereich
    End With
    
    With rng
        tAV = .Value
        .Sort .Columns(SpalteLohntext)
        AV = .Value
    End With
    getUniques AV, Uns, SpalteLohntext
    E = UBound(Uns)
    With rng
        .Sort .Columns(SpalteNamen)
        AV = .Value
    End With
    
    I = 1
    ReDim Out(E + 1, I)
    E2 = UBound(AV)
    lV = AV(1, SpalteNamen)
    
    For R = 2 To E2
    
        V = AV(R, SpalteNamen)
        MInd = getMatchInd(AV(R - 1, SpalteLohntext), Uns, E) + 1
        Out(MInd, I) = AV(R - 1, SpalteStunden)
        
        If R = E2 Or V <> lV Then
            Out(0, I) = lV
            lV = V
            I = I + 1
            ReDim Preserve Out(E + 1, I)
        End If

    Next
    MInd = getMatchInd(AV(R - 1, SpalteLohntext), Uns, E) + 1
    Out(MInd, I - 1) = AV(R - 1, SpalteStunden)
    I = I - 1
    ReDim Preserve Out(E + 1, I)
    For R = 1 To E + 1
        Out(R, 0) = Uns(R - 1)
    Next
    
    myTP Out, Out
    With Sheets(2)
        .Range(.Cells(1, 10), .Cells(1 + UBound(Out), 10 + UBound(Out, 2))).Value = Out
    End With
    rng.Value = tAV
    
End Sub

Private Function myTP(AV, AVtr)
Dim SaveAV, R&, C&, S1&, S2&, E1&, E2&
SaveAV = AV

    S1 = LBound(AV)
    S2 = LBound(AV, 2)
    E1 = UBound(AV)
    E2 = UBound(AV, 2)
    ReDim AVtr(S2 To E2, S1 To E1)

    For R = S1 To E1
        For C = S2 To E2
            AVtr(C, R) = SaveAV(R, C)
        Next
    Next
    
End Function

Private Function getMatchInd(ByVal str$, Uns$(), ByVal E&) As Long
Dim I&
    
    For I = 0 To E
        If str = Uns(I) Then
            getMatchInd = I
            Exit For
        End If
    Next
    
End Function

Private Sub getUniques(ByVal AV, ByRef Uns$(), ByVal C&)
Dim R&, I&, E&, V, lV
    
    E = UBound(AV)
    lV = AV(1, C)
        
    ReDim Uns(0)
    Uns(0) = lV
    I = 1
    For R = 2 To E
        V = AV(R, C)
        If Not IsError(V) And Not IsError(lV) Then
            If V <> lV Or R = E Then
                ReDim Preserve Uns(I)
                Uns(I) = V
                lV = V
                I = I + 1
            End If
        End If
    Next
    
End Sub

Ausgabe erfolgt im Arbeitsblatt zwei...