Объединение двух списков

Sub Main()
Dim Sh_fio As Worksheet
Dim Sh_cod As Worksheet
Dim Sh_res As Worksheet
 
Dim Vuz_Name(1 To 1000) As String
Dim Vuz_Code(1 To 1000) As String
 
    Set Sh_res = ThisWorkbook.Sheets("Результат")
    Set Sh_fio = ThisWorkbook.Sheets("ФИО")
    Set Sh_cod = ThisWorkbook.Sheets("Классификатор")
 
    '::: Чистим лист результата
 
    Sh_res.Select
    Cells.Select
    Selection.ClearContents
    
    '::: Грузим классификатор
    
    vNum% = 0
    
    For iii% = 2 To 1002
        Tmp$ = Trim$(Sh_cod.Cells(iii%, 1).Value)
        If Len(Tmp$) = 0 Then Exit For
        vNum% = vNum% + 1
        Vuz_Name(vNum%) = Tmp$
        Vuz_Code(vNum%) = Trim$(Sh_cod.Cells(iii%, 2).Value)
    Next iii%
    
    '::: Объединение
    
    ooo% = 1
    
    For iii% = 2 To 2000
    
        cFio$ = Trim$(Sh_fio.Cells(iii%, 1).Value)
        cCod$ = Trim$(Sh_fio.Cells(iii%, 2).Value)
    
        If Len(cFio$) = 0 Then Exit For
        
        ooo% = ooo% + 1
        
        Sh_res.Cells(ooo%, 1).Value = cFio$
        Sh_res.Cells(ooo%, 2).Value = cCod$
        
        For jjj% = 1 To vNum%
            
            If cCod$ = Vuz_Code(jjj%) Then
               Sh_res.Cells(ooo%, 3).Value = Vuz_Name(jjj%)
               Exit For
            End If
            
        Next jjj%
        
     Next iii%
    
     Sh_res.Cells(1, 1).Select
     
     MsgBox "OK!"
 
End Sub