Auto align data of an Excel table

The objective is to process a table with names.
I want to shift columns right and align the same name into one single column when a new name is introduced in the bottom row.

I have attached the raw table screenshot before the macro process, current result table screenshot, and expected result table screenshot.

In the current result table, the macro has shifts columns to right and aligns the same name into one column.
However, Yuna in Cell F6, F7 and Angel in Cell G4, G5 go missing.
What I want is in the expected result table screenshot.

raw table

current result table

expected result table

Sub AlignNamesTwoPass()
    Dim wsRaw As Worksheet, wsResult As Worksheet
    Dim lastRowRaw As Long, lastColRaw As Long
    Dim dict As Object
    Dim rRaw As Long, cRaw As Long
    Dim rowData() As String
    Dim resultRow As Long, resultCol As Long
    Dim name As String

    ' Define sheet names
    Const RAW_SHEET_NAME As String = "Sheet1"
    Const RESULT_SHEET_NAME As String = "Result_Table"

    ' Set worksheets
    On Error Resume Next
    Set wsRaw = ThisWorkbook.Sheets(RAW_SHEET_NAME)
    Set wsResult = ThisWorkbook.Sheets(RESULT_SHEET_NAME)
    On Error GoTo 0

    If wsRaw Is Nothing Or wsResult Is Nothing Then
        MsgBox "Error: One or both sheets not found!", vbCritical
        Exit Sub
    End If

    ' Find last used row and column in raw data
    lastRowRaw = wsRaw.Cells(wsRaw.Rows.Count, 1).End(xlUp).Row
    lastColRaw = wsRaw.Cells(1, wsRaw.Columns.Count).End(xlToLeft).Column

    ' Clear previous results before writing new ones
    wsResult.Cells.ClearContents

    ' Initialize dictionary for column assignments
    Set dict = CreateObject("Scripting.Dictionary")

    ' **Pass 1: Collect all unique names and assign columns**
    For rRaw = lastRowRaw To 1 Step -1
        For cRaw = 1 To lastColRaw
            name = Trim(wsRaw.Cells(rRaw, cRaw).Value)

            ' Preserve empty/null cells
            If name = "" Then name = "Null"

            ' Assign a column for each unique name
            If Not dict.exists(name) Then
                dict.Add name, dict.Count + 1  ' Assign next available column
            End If
        Next cRaw
    Next rRaw

    ' **Pass 2: Place names into their assigned columns**
    For rRaw = 1 To lastRowRaw
        For cRaw = 1 To lastColRaw
            name = Trim(wsRaw.Cells(rRaw, cRaw).Value)

            ' Ensure empty values still shift correctly
            If name = "" Then name = "Null"

            ' Find the assigned column and place the value
            resultCol = dict(name)
            wsResult.Cells(rRaw, resultCol).Value = name
        Next cRaw
    Next rRaw

Cleanup:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox "Final alignment completed! Names should now be correctly placed in 'Result_Table'.", vbInformation
End Sub

lastColRaw in your script doesn't catch the last column of the raw table. The below line gets the last col of the raw table.

    ' Find last used row and column in raw data
    lastColRaw = wsRaw.UsedRange.Columns.Count

Your logic for blank cells wasn't specified in OP. I've revised it as shown below, and the output now matches your expected result.

Note: For large tables, consider loading the raw data into an array for better performance.

Sub AlignNamesTwoPass()
    Dim wsRaw As Worksheet, wsResult As Worksheet
    Dim lastRowRaw As Long, lastColRaw As Long
    Dim dict As Object
    Dim rRaw As Long, cRaw As Long
    Dim rowData() As String
    Dim resultRow As Long, resultCol As Long
    Dim name As String

    ' Define sheet names
    Const RAW_SHEET_NAME As String = "Sheet1"
    Const RESULT_SHEET_NAME As String = "Result_Table"

    ' Set worksheets
    On Error Resume Next
    Set wsRaw = ThisWorkbook.Sheets(RAW_SHEET_NAME)
    Set wsResult = ThisWorkbook.Sheets(RESULT_SHEET_NAME)
    On Error GoTo 0

    If wsRaw Is Nothing Or wsResult Is Nothing Then
        MsgBox "Error: One or both sheets not found!", vbCritical
        Exit Sub
    End If

    ' Find last used row and column in raw data
    lastRowRaw = wsRaw.UsedRange.Rows.Count
    lastColRaw = wsRaw.UsedRange.Columns.Count

    ' Clear previous results before writing new ones
    wsResult.Cells.ClearContents

    ' Initialize dictionary for column assignments
    Set dict = CreateObject("Scripting.Dictionary")

    ' **Pass 1: Collect all unique names and assign columns**
    For rRaw = lastRowRaw To 1 Step -1
'        lastColRaw = wsRaw.Cells(rRaw, wsRaw.Columns.Count).End(xlToLeft).Column
        For cRaw = 1 To lastColRaw
            name = Trim(wsRaw.Cells(rRaw, cRaw).Value)

            ' Preserve empty/null cells
            If name = "" Then name = "Null"
            ' Assign a column for each unique name
            If Not dict.exists(name) Then
                dict.Add name, dict.Count + 1  ' Assign next available column
            End If
        Next cRaw
    Next rRaw

    ' **Pass 2: Place names into their assigned columns**
    For rRaw = 1 To lastRowRaw
'        lastColRaw = wsRaw.Cells(rRaw, wsRaw.Columns.Count).End(xlToLeft).Column
        For cRaw = 1 To lastColRaw
            name = Trim(wsRaw.Cells(rRaw, cRaw).Value)

            ' Ensure empty values still shift correctly
            If name = "" Then name = "Null"

            ' Find the assigned column and place the value
            resultCol = dict(name)
            wsResult.Cells(rRaw, resultCol).Value = IIf(name = "Null", "", name)
        Next cRaw
    Next rRaw

Cleanup:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox "Final alignment completed! Names should now be correctly placed in 'Result_Table'.", vbInformation
End Sub