Sub bound_data_Ofresorce_to_volume(ws As Worksheet)
    Dim i As Integer
    Dim lastRow As Long
    Dim wsR As Worksheet
    Dim wsV As Worksheet
    Dim lastColumn As Integer
    Dim wsNumber As Integer
    Dim t As String
    Dim arr() As Variant

    ' Отключаем обновление экрана и автоматический пересчет
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' Устанавливаем wsR для первого листа
    Set wsR = ThisWorkbook.Worksheets(1)

    ' Находим номер листа ws в книге
    For i = 1 To ThisWorkbook.Worksheets.Count
        If ThisWorkbook.Worksheets(i).Name = ws.Name Then
            wsNumber = i - 1
        End If
    Next i

    ' Устанавливаем wsV для следующего листа
    Set wsV = ThisWorkbook.Worksheets(wsNumber + 1)

    ' Определяем последнюю заполненную строку в столбце C на листе wsV
    lastRow = wsV.Range("C" & Rows.Count).End(xlUp).Row
    
    ' Заполняем массив данными из диапазона A1:GlastRow на листе wsV
    arr = wsV.Range("A1:G" & lastRow).Value2

    ' Находим последний столбец с данными на листе wsR перед строкой, где значение в столбце A равно 1
    For i = 1 To lastRow
        If wsR.Range("A" & i) = 1 Then Exit For
            lastColumn = wsR.Cells(i, Columns.Count).End(xlToLeft).Column
    Next i
    
    ' Заменяем на соответствующий комментарий
    For i = startingPoint To lastRow
        If lastColumn = 6 Then
            arr(i, 7) = "=IFERROR(INDEX('" & wsR.Name & "'!E:E,MATCH('" & wsV.Name & "'!C" & i & " & "" "" & '" & wsV.Name & "'!D" & i & ", '" & wsR.Name & "'!B:B & "" "" & '" & wsR.Name & "'!C:C,0)),"""")"
        ElseIf lastColumn = 7 Then
            arr(i, 7) = "=IFERROR(INDEX('" & wsR.Name & "'!F:F,MATCH('" & wsV.Name & "'!C" & i & " & "" "" & '" & wsV.Name & "'!D" & i & ", '" & wsR.Name & "'!C:C & "" "" & '" & wsR.Name & "'!D:D,0)),"""")"
        End If
    Next i

    ' Записываем данные из массива обратно в диапазон A1:GlastRow на листе wsV
    wsV.Range("A1:G" & lastRow).Value2 = arr

    ' Включаем обновление экрана и автоматический пересчет
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    ' Устанавливаем время в ячейку K2 на листе ws
    t = "Данные обновлены " & Format(Now, "HH:MM:SS")
    ws.Range("K2") = t
End Sub