Sub mrshkei()
Dim arr, arr2, arr3, arr4, i As Long, sh As Worksheet, sh2 As Worksheet
Dim lr As Long, lr2 As Long, lr3 As Long
Set sh = Worksheets("Прайс 1С"): Set sh2 = Worksheets("Прайс Автотраст"): Set sh3 = Worksheets("Прайс Шатэ")
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
lr3 = sh3.Cells(Rows.Count, 1).End(xlUp).Row
arr = sh.Range("A2:H" & lr)
arr2 = sh2.Range("A2:H" & lr2)
arr3 = sh3.Range("A2:H" & lr3)
ReDim arr4(1 To lr, 1 To 2)
For i = LBound(arr) To UBound(arr)
    ind = arr(i, 8)
    If Application.WorksheetFunction.CountIf(sh2.Columns(8), ind) > 0 Then
    For n = LBound(arr2) To UBound(arr2)
        If ind = arr2(n, 8) Then
            If arr4(i, 1) = Empty Then
                arr4(i, 1) = CDbl(arr2(n, 5)): arr4(i, 2) = sh2.Name
            Else
                If arr4(i, 1) > CDbl(arr2(n, 5)) Then arr4(i, 1) = CDbl(arr2(n, 5)): arr4(i, 2) = sh2.Name
            End If
        End If
    Next n
    End If
    If Application.WorksheetFunction.CountIf(sh3.Columns(8), ind) > 0 Then
    For n = LBound(arr3) To UBound(arr3)
        If ind = arr3(n, 8) Then
            If arr4(i, 1) = Empty Then
                arr4(i, 1) = CDbl(arr3(n, 5)): arr4(i, 2) = sh3.Name
            Else
                If arr4(i, 1) > CDbl(arr3(n, 5)) Then arr4(i, 1) = CDbl(arr3(n, 5)): arr4(i, 2) = sh3.Name
            End If
        End If
    Next n
    End If
Next i
sh.Range("J2").Resize(UBound(arr4), 2) = arr4
End Sub