Копирование данных с листа1 на Лист2 с Пробелами

Option Compare Text
Sub Копирование_с_присвоением_кодов()
    Dim i&, j&, LastRow&, T
    With Sheets(1)
        With .UsedRange
            LastRow = .Rows.Count + .Row - 1
        End With
        For i = 4 To LastRow
            For j = 2 To 4
                T = Sheets(1).Cells(i, j)
                Select Case Trim(T)
                    Case "ООО РМО ""ПЕРВЫЙ ПРОСПЕКТ""": T = 1
                    Case "OOO СК ""Пятая колонна-Ж"" (ранее ООО НМСК ""Русский север"")": T = 2
                    Case "OOO СК ""Городовой"" (ранее ООО НМСК ""Городовой метр"")": T = 3
                    Case "Опель Инсигниа №25": T = 89
                    Case "Опель Кадет №96": T = 101
                    Case "Опель Фронтера №695 5д": T = 104
                    Case "Мазда 223 №78": T = 99
                    Case "Шевролет Каптива 3.2 №59": T = 45
                    Case "Опель Антара №69": T = 125
                    Case "I20.0-Общая диагностика": T = "I20.0"
                    Case "I20.9-Замена саленблока": T = "I20.9"
                    Case "T40.6-Замена аккумулятора": T = "T40.6"
                    Case "T51-Чистка салона": T = "T51"
                    Case "T78.4-Покраска кузова": T = "T78.4"
                    Case "I200.9-Ремонт ходовой": T = "I200.9"
                    Case "", "-": If j = 2 Then T = 0 Else T = ""
                End Select
                Sheets(2).Cells(i, j) = T
            Next j
        Next i
    End With
End Sub

Option Explicit
 
Sub tt()
    Dim a, i&, ii&
    With CreateObject("scripting.dictionary"): .comparemode = 1
        a = Sheets("критерии").[a1].CurrentRegion.Value
        For i = 1 To UBound(a): .Item(a(i, 1)) = a(i, 2): Next
        a = Sheets("Лист0").[B3].CurrentRegion.Value
        For i = 1 To UBound(a)
            For ii = 1 To UBound(a, 2)
                a(i, ii) = .Item(Trim(a(i, ii)))
            Next
        Next
    End With
    Sheets("Лист1").[f3].Resize(UBound(a, 1), UBound(a, 2)) = a
End Sub