'v2
Sub SetValidation()
    SetSheetValidation Sheets("Лист1")
End Sub

Sub SetSheetValidation(sh As Worksheet)
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    InitValidation dic, Sheets("СПИСОК Поставщиков")

    Dim cl As Range
    For Each cl In sh.UsedRange.Columns(2).Cells
        SetCellValidation cl, dic
    Next
End Sub

Private Sub InitValidation(dic As Object, sh As Worksheet)
    Dim dicY As Object
    Set dicY = CreateObject("Scripting.Dictionary")
    dicY.CompareMode = 1
    
    Dim dicN As Object
    Set dicN = CreateObject("Scripting.Dictionary")
    dicN.CompareMode = 1
    Dim dicI As Object
    
    
    With sh
        Dim yy As Long
        yy = .Cells(.Rows.Count, 1).End(xlUp).Row
        Dim arr As Variant
        arr = .Cells(1, 1).Resize(yy, 2)
    End With
    For yy = 1 To UBound(arr, 1)
        If Not IsEmpty(arr(yy, 1)) Then
            If Not dicY.Exists(arr(yy, 1)) Then
                dicY.Item(arr(yy, 1)) = yy
                Set dicN.Item(arr(yy, 1)) = CreateObject("Scripting.Dictionary")
            End If
            dicN.Item(arr(yy, 1)).Item(arr(yy, 2)) = 0
        End If
    Next
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim Application_Calculation As Long
    Application_Calculation = Application.Calculation
    Application.Calculation = xlCalculationManual

    Dim sValidation As String
    Dim vv As Variant
    For Each vv In dicY.Keys()
        yy = dicY.Item(vv)
        Set dicI = dicN.Item(vv)
        With sh.Cells(yy, 4).Resize(1, dicI.Count)
            .Value = dicI.Keys()
            sValidation = "='" & sh.Name & "'!" & .Address(1, 1)
        End With
        dic.Item(arr(yy, 1)) = sValidation
    Next

    Application.Calculation = Application_Calculation
    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

Private Sub SetCellValidation(cl As Range, dic As Object)
    With cl.Cells(1, 2).Validation
        .Delete
        If dic.Exists(cl.Value) Then
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=dic.Item(cl.Value)
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = False
            .ShowError = True
        End If
    End With
End Sub