Sub Автоматизация_формы()

    Dim shSrc As Worksheet, shRes As Worksheet
    Dim collSrc As New Collection, arrSrc(), arrRes()
    Dim lr As Long, r As Long, i As Long
    
    Set shSrc = Worksheets("Лист1")
    Set shRes = Worksheets("Лист2")
    
    lr = shSrc.Cells(shSrc.Rows.Count, "A").End(xlUp).Row
    arrSrc() = shSrc.Range("A1:E" & lr).Value
    For i = 2 To UBound(arrSrc)
        collSrc.Add item:=i, key:=CStr(arrSrc(i, 1))
    Next i
    
    lr = shRes.Cells(shRes.Rows.Count, "A").End(xlUp).Row
    arrRes() = shRes.Range("A2:E" & lr).Value
    
    For i = 1 To UBound(arrRes)
        r = 0
        On Error Resume Next
        r = collSrc(CStr(arrRes(i, 1)))
        On Error GoTo 0
        If r <> 0 Then
            arrRes(i, 2) = arrSrc(r, 4)
            arrRes(i, 3) = arrSrc(r, 3)
            arrRes(i, 4) = arrSrc(r, 5)
            arrRes(i, 5) = arrSrc(r, 2)
        End If
    Next i
    
    shRes.Range("A2").Resize(UBound(arrRes, 1), UBound(arrRes, 2)).Value = arrRes()
    
    MsgBox "Готово!", vbInformation

End Sub

arrSrc() = shSrc.Range("A1:E" & lr).Value
***
arrRes() = shRes.Range("A2:E" & lr).Value
заменить на
arrSrc() = shSrc.Range("A1:K" & lr).Value
***
arrRes() = shRes.Range("A2:K" & lr).Value