Use a proxy to find the right person

I have a Macro, it basically allocates Person and Grade Level to Classes in a new worksheet. It then makes bold any instance where a person is not in HC data. That is not that important, it is all functioning well. In my code, I highlighted, in bold, the area I need help on. This is where I figure out if the data is missing and then make it bold. Instead of making it bold I was wondering if it was possible, to try to allocate the data based off the last 4 digits of the person, but with the first 3 being 011. In my sample workbook, I am missing HC data for 015 5858, I would then like to see if there is HC data for 011 5858 and then copy that data within the HC sheet (but replacing the Person as 015 5858). In my workbook I included a HC sheet and a HC After... the HC after is what I would like the end result to be.

There is always 3 spaces in between the left numbers and the right numbers and they are stored as text. I am basically looking for something that will, within that IF statement I bolded, Find "011 " & RIGHT(cname,4) in HC, and copy all instances below the last row but replaced cname for the person (in this example 015 5858).

Option Explicit
Public Sub TitleAllocation()
    'Clear End Result
    Sheets("End Result").Cells.Clear
    'Do not show me what is happening until everything is over [helps speed]
    Application.ScreenUpdating = False
    'Defining Variables
    Dim LR As Long
    Dim LR1 As Long
    Dim LR2 As Long
    Dim Rng As Range
    Dim Rng1 As Range
    Dim cName As Range
    Dim cName1 As Range
    Dim ctr As Long

    'Set LR as The amount of rows in Data
    LR = Sheets("Data").Range("B" & Rows.Count).End(xlUp).Row
    'Set LR1 as the amount of rows in HC
    LR1 = Sheets("HC").Range("B" & Rows.Count).End(xlUp).Row
    'Set Rng as all information in Range B in Data
    Set Rng = Sheets("Data").Range("B2:B" & LR)
    'Set Rng1 as all information in Range A in HC
    Set Rng1 = Sheets("HC").Range("A2:A" & LR1)
    'Takes away all Bold rows in Data to get rid of old 'errors'
    For Each cName In Rng
        cName.EntireRow.Font.Bold = False
    Next cName
    'For every row in column B in Data, Find matches in column A in HC, and with the matches you find: Copy the corresponding column A &B in Data [Grade Level and Person] to columns A&B of the next empty row in End Result,
    '                   ------>>>> And then Copy the Class in column B of HC to column C of End Result
    For Each cName In Rng
        For Each cName1 In Rng1
            If cName = cName1 Then
                'Set LR2 as last row in End Result
                LR2 = Sheets("End Result").Range("B" & Rows.Count).End(xlUp).Row
                Sheets("End Result").Range("A" & LR2 + 1 & ":" & "B" & LR2 + 1) = cName.Offset(0, -1).Resize(1, 2).Value
                Sheets("End Result").Range("C" & LR2 + 1) = cName1.Offset(0, 1).Value
            End If
        Next cName1
    Next cName
    'This next section will make any row that is missing HC data BOLD in Data
    LR2 = Sheets("End Result").Range("B" & Rows.Count).End(xlUp).Row
    For Each cName In Rng
        If Application.CountIf(Sheets("End Result").Range("B2:B" & LR2), cName) = 0 Then
        cName.EntireRow.Font.Bold = True
            
        End If
        Next cName
        
    'Update the screen with the new data
    Application.ScreenUpdating = True
End Sub

Edit:
I have the following code done, I think I may just need help with my Copy/Paste coding

For Each cName In Rng
        If Application.CountIf(Sheets("End Result").Range("B2:B" & LR2), cName) = 0 Then
        cName.EntireRow.Font.Bold = True
        For Each cName1 In Rng1
            If cName1 = "011   " & Right(cName, 4) Then
            LR1 = Sheets("HC").Range("B" & Rows.Count).End(xlUp).Row
            cName1.EntireRow.Copy
            Sheets("HC").Range("A" & LR1 + 1).EntireRow.Paste
            Sheets("HC").Range("A" & LR1 + 1) = cName
            End If
            Next
        End If
        Next cName

LR2 = Sheets("End Result").Range("B" & Rows.Count).End(xlUp).Row
    For Each cName In Rng
        If Application.CountIf(Sheets("End Result").Range("B2:B" & LR2), cName) = 0 Then
        cName.EntireRow.Font.Bold = True
        For Each cName1 In Rng1
            If cName1 = "011   " & Right(cName, 4) Then
            LR1 = Sheets("HC").Range("A" & Rows.Count).End(xlUp).Row
            Sheets("HC").Range("A" & LR1 + 1 & ":Z" & LR1 + 1) = cName1.Resize(1, 26).Value
            Sheets("HC").Range("A" & LR1 + 1) = cName
          
            End If
            Next
        End If
        Next cName

Woooh