Private m_customers As Collection

Private Sub add_combo(target_cell As Range, lst_customers As Collection)

    If (target_cell.value = "filled") Then Exit Sub
    target_cell.value = "filled"

    Dim i As Integer
    Dim ole As OLEObject
    Dim combo As MSForms.ComboBox

    Set ole = ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, _
        DisplayAsIcon:=False, Left:=target_cell.Left, Top:=target_cell.Top, Width:=target_cell.Width, Height:=target_cell.Height)

    Set combo = ole.Object
    
    With combo
        .SpecialEffect = fmSpecialEffectSunken
        .Font.Size =  8 
        .TextAlign = fmTextAlignCenter
    End With


    For i =  1  To lst_customers.Count
        combo.AddItem (lst_customers(i))
    Next
    
End Sub

Private m_customers As Collection



Private Sub Workbook_Open()
    Set m_customers = Customers
End Sub




Property Get Customers() As Collection


    Dim m_customers As Collection
    Set m_customers = New Collection
    
    m_customers.Add ("a")
    
    Set Customers = m_customers

End Property





Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    Dim target_cell As Range
    Dim tmp As Variant

    For Each tmp In Target 
        Set target_cell = tmp
        Call add_combo(target_cell, m_customers)
    Next tmp

    'вот первый раз этот цикл нормально отрабатывает, 
    'а по выходу из цикла коллекция умирает
    
End Sub




Private Sub add_combo(target_cell As Range, m_customers As Collection)

    Dim i As Integer
    Dim ole As OLEObject
    Dim combo As MSForms.ComboBox

    Set ole = ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, _
        DisplayAsIcon:=False, Left:=target_cell.Left, Top:=target_cell.Top, Width:=target_cell.Width, Height:=target_cell.Height)

    Set combo = ole.Object

    For i =  1  To m_customers.Count
        combo.AddItem (m_customers(i))
    Next
    
End Sub

Public Sub add_dropDown(target_cell As Range)

    Dim i As Integer, idx As Integer
    Dim ddl As DropDown
    
    idx = IIf((target_cell.Value <> ""), get_index(target_cell.Value, ThisWorkbook.Customers),  0 )

    Set ddl = ActiveSheet.DropDowns.Add( _
        target_cell.Left, target_cell.Top, target_cell.Width, target_cell.Height)
        
    For i =  1  To ThisWorkbook.Customers.Count
        Call ddl.AddItem(ThisWorkbook.Customers(i))
    Next
      
    With ddl
      .LinkedCell = target_cell.Address
      .PrintObject = False
      .OnAction = "set_data"
      .ListIndex = idx
    End With
    
End Sub