Копирование данных из ячейки одного листа на другой с условием

Option Explicit
 
Sub tt()
    Dim a, i As Long, arr, t As String, col As New Collection
 
    With CreateObject("scripting.dictionary"): .comparemode = 1
        .Item("ОТКАЗ") = 9
        .Item("1") = 5
        .Item("5") = 3
 
        a = Sheets(1).[b4].CurrentRegion.Value
        For i = 1 To UBound(a)
            arr = Split(a(i, 1), " - ")
            If UBound(arr) = 1 Then
                t = Trim(arr(0)): If .exists(t) Then col.Add .Item(t)
            End If
        Next
    End With
 
    ReDim a(1 To col.Count, 1 To 1)
    For i = 1 To col.Count: a(i, 1) = col(i): Next
    Sheets(2).[g4].Resize(col.Count, 1) = a
End Sub

For i = 4 To 65536  'Копируем сколько лет
    Sheets(2).Cells(i, 6).Resize(, 1) = Split(Application.Trim(Sheets(1).Cells(i, 4)), , 3)
Next i

iLastRow = Cells(Rows.Count, 1).End(xlUp).Row

Sub M1()
 
 
Range("E4:E" & Cells(Rows.Count, 5).End(xlUp).Row).Copy Worksheets("Лист1").Range("H4")  'копируем дату рождения
    
 
For i = 4 To Cells(Rows.Count, 4).End(xlUp).Row  'Копируем сколько лет
    Sheets(2).Cells(i, 6).Resize(, 1) = Sheets(1).Cells(i, 4)
Next i
 
End Sub

a = Sheets(1).[b4].CurrentRegion.Value

a = Sheets(1).[b4].CurrentRegion.Value

 With Worksheets(1)
      arr = .Range("C4:B" & .Cells(Rows.Count, "C").End(xlUp).Row).Value
    End With
    For i2 = 1 To UBound(arr)
        If arr(i2, 1) <> "" Then arr(i2, 1) = Split(arr(i2, 1))(0)
    Next
    Worksheets("Ëèñò1").Range("G4").Resize(UBound(arr), 1) = arr