Option Explicit
Public Function GetDelay(supplier As String, category As String) As Variant
Dim DelayDict As Object ' назначаем библиотеку как объект
Dim i&, j&  ' назначаем целые переменные i и j
Dim delaykey As String ' назначаем сводную переменную  delaykey для поиска
Dim key As String ' назначаем переменную ключей библиотеки
Dim item As String ' назначаем переменную элементов библиотеки
Dim row_end, col_end As Integer ' назначаем переменные номеров последней строки и столбца в таблице можностей радиатора

Application.ScreenUpdating = False
Set DelayDict = New Scripting.Dictionary  'назначаем новую библиотеку объектной переменной DelayDict

delaykey = supplier & category 'определяем сводную переменную как конкатенацию параметров: поставщик и категория

With Sheets("Отсрочка") ' для листа Отсрочка

row_end = .UsedRange.Rows.Count 'определяем последнюю строку:  число заполненных строк
col_end = .UsedRange.Columns.Count  'определяем последний столбец:  число заполненных столбцов

For i = 2 To row_end ' цикл по строкам, начиная с 1-й занятой строки до последней занятой строки

key = .Cells(i, 5) ' определяем ключ из столбца 5 листа для библиотеки
item = .Cells(i, 4)  ' определяем элемент из столбца 4 листа для библиотеки
DelayDict.Add key, item ' добавляем в библиотеку определенные  ключи и элементы
Next i ' следующая строка
End With

With DelayDict 'для библиотеки
If DelayDict.Exists(delaykey) Then 'если существует сводный параметр - ключ delaykey
GetDelay = DelayDict.item(delaykey) ' пользовательская функция извлекает из библиотеки соответствующий ему элемент
по ключу delaykey
Else ' иначе
GetDelay = 0 ' нет данных
End If 'конец условия
End With

Application.ScreenUpdating = True
End Function

' макрос (create_payment_report) для переноса данных из отчета по закупкам в отчет по оплате

Public Sub create_payment_report()
Dim date_cell As Date
Dim Next_date As String
Dim weeks_delay As Integer
Dim k&, l&
Dim row_end, col_end  As Integer

With ActiveSheet ' активный лист
' узнать размерность массива
row_end = .Cells.Find("*", [A1], xlValues, , xlByRows, xlPrevious).Row 'последняя заполненная строка
col_end = .Cells.Find("*", [A1], xlValues, , xlByRows, xlPrevious).Column 'последний заполненный столбец
' переносим данные из закупок в Отчет по оплате
MsgBox "Перенос данных в отчет по оплате......"
For l = 5 To row_end '  цикл по строкам из таблицы Закупки
weeks_delay = .Cells(l, 3).Value ' число недель отсрочки платежа
For k = 1 To 12 * 4 ' в таблице Закупки 48 столбцов с датами
ActiveWorkbook.Sheets("Отчет по оплате").Cells(l, 4 + k + weeks_delay - 1).Value = ActiveWorkbook.Sheets("Отчет по закупке").Cells(l, 4 + k - 1).Value
Next k ' продолжаем цикл по столбцам
Next l ' продолжаем цикл по строкам
MsgBox "отчет по оплате сформирован"
End With
End Sub