Копирование диапазона из двух книг в одну с двумя условиями - VBA

Формулировка задачи:

Здравствуйте. Хочу попросить вас о помощи, в доработке макроса. Задача состоит в том, что есть 2 книги источника komus_opt_ret_3 и komus-price-msk, в komus-price-msk нужно создать макрос,который копирует столбцы из двух книг в новую и выполняет определённые условия. То есть из этих двух книг столбцы, которые выделены красным нужно скопировать в новую книгу, но перед этим должны срабатывать 2 условия: 1.Если товар с артикулом из прайс-листа komus-price-msk совпадает с артикулом komus_opt_ret_3, тогда добавляем цены( цена,руб, цена в ИМ) в новую книгу и в столбике "наименование" название товара выделить жёлтым, если артикул не совпадает то, не выделять и оставить ячейки с ценой пустыми; 2.Если в komus_opt_ret_3 наличие на складе слово "нет", тогда вся строка в новой книге выделяется красным. Проблема в том, что копируется диапазон в новую книгу не совсем правильно, без разделов и два столбика из komus-price-msk при добавлении в новую книгу съезжают вверх. Второе условие со складом работает, как надо. Но первое нет, не ищет одинаковые артикулы и не выделяет жёлтым при добавлении. Оба прайс-листа должны быть открыты, для работы макроса. Помогите разобраться с задачей, пожалуйста.

Ребят не смог сюда загрузить задачу, поэтому ссылка на её архивhttp://rgho.st/7LkvDfLdQ

Решение задачи: «Копирование диапазона из двух книг в одну с двумя условиями»

textual
                            Листинг программы 
                        

                            Sub Слияние_диапазонов2()
    Dim i&, k&, j&, A, B, Dic, Ra
    Dim StIst1:  StIst1 = Array(4, 5, 8, 9, 10, 11, 12, 13, 14, 18, 19) ' Из komus_opt_ret_3.xlsx"
    Dim StCel:        StCel = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13)
    Dim StIst2:                                          StIst2 = Array(5, 6) 'Из этой книги
    Set Dic = CreateObject("Scripting.Dictionary")
    A = Workbooks("komus_opt_ret_3").Sheets("Опт прайс-лист").UsedRange.Value
    B = ThisWorkbook.Sheets("komus-price-msk").UsedRange.Value
    Workbooks.Add
    Application.ScreenUpdating = False
    For i = 1 To UBound(B)
        If B(i, 3) <> "" Then Dic(B(i, 3)) = i
    Next i
    For i = 3 To UBound(A)
        If Trim(A(i, 4)) & Trim(A(i, 5)) = "" Then A(i, 4) = A(i, 1)
        For j = 0 To UBound(StIst1)
            Cells(i - 2, StCel(j)) = A(i, StIst1(j))
        Next j
        If Dic.Exists(A(i, 4)) Or i = 1 Then
            If i = 1 Then
                k = 1
            Else
                k = Dic(A(i, 4))
                Cells(i - 2, 2).Interior.color = vbYellow
            End If
            For j = 0 To UBound(StIst2)
                Cells(i - 2, StCel(11 + j)) = B(k, StIst2(j))
            Next j
        End If
        With Cells(i - 2, 1).Resize(1, 13)
            .Interior.color = Workbooks("komus_opt_ret_3").Sheets("Опт прайс-лист").Cells(i, 1).Interior.color
            .Borders.LineStyle = xlContinuous
            .Offset(, 1).NumberFormat = "#,##0.00"
            If LCase(Trim(A(i, 13))) = "нет" Then .Interior.color = vbRed
        End With
        Cells(i - 2, 11).NumberFormat = "#"
    Next i
    Set Dic = Nothing
End Sub
                        