Od razu powiem, że nie jest to dobre rozwiązanie. Spędziłem łącznie nad tym trochę czasu. Excel pomimo, że zapisze dane z listy w arkuszu tj. pozbędziemy się listy i zostawimy wartości przy otwarciu skoroszytu może (raczej na pewno) pojawić się błąd.

Ten błąd to „Removed Feature: Data validation from /xl/worksheets/…”. Jak dla mnie, jeżeli ustawimy źródło w tablicy, która jest ulotna, przy otwarciu Excel chce zaciągnąć dane do listy rozwijalnej. I to pomimo faktu, że tej listy de facto nie ma, a kod tworzący listę nie jest uruchamiany przy starcie aplikacji.

Najbezpieczniej jest umieścić źródło listy dynamicznej w arkuszu, a to spowoduje, że błąd 'Removed Feature: Data validation from /xl/worksheets/…’ nie pojawi się.

Dodawanie dynamicznej listy rozwijalnej:

Dim LastRow As Long

' Szukanie ostatniego wiersza w zakresie
' aby dodac listę rozwijalną w całym zakresie

ThisWorkbook.Sheets("SheetName").Select
With ThisWorkbook.Sheets("SheetName")
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

' Czyszczenie wcześniejszej listy rozwijalnej
ThisWorkbook.Sheets("PSheetName").Range(Cells(10, 5), Cells(LastRow, 11)).Select
With Selection.Validation
    .Delete
    .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
    :=xlBetween
    .IgnoreBlank = True
    .InCellDropdown = True
    .ShowInput = True
    .ShowError = True
End With

' Dodawanie Dymanicznej Listy Rozwijalnej do kolumny E (numer 5)
ThisWorkbook.Sheets("Plik Wsadowy - Obrotówka").Range(Cells(10, 5), Cells(LastRow, 5)).Select
With Selection.Validation
   .Delete
   .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
   xlBetween, Formula1:=Join(AktywaPasywaArray(), ",")
   .IgnoreBlank = True
   .InCellDropdown = True
   .InputTitle = "Please choose item:"
   .ErrorTitle = "Wrong item:"
   .InputMessage = "Please choose item from the list."
   .ErrorMessage = "Typed item is not allowed."
   .ShowInput = True
   .ShowError = True
End With
End Sub

Usuwanie listy rozwijalnej:

Sub UsunListeRozwijalna
Dim LastRow As Long

' Szukanie ostatniego wiersza w zakresie aby usunac listę rozwijalną w całym zakresie
ThisWorkbook.Sheets("SheetName").Select
With ThisWorkbook.Sheets("SheetName")
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

' Czyszczenie wcześniejszej listy rozwijalnej
ThisWorkbook.Sheets("SheetName").Range(Cells(10, 5), Cells(LastRow, 11)).Select
With Selection.Validation
    .Delete
    .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
    :=xlBetween
    .IgnoreBlank = True
    .InCellDropdown = True
    .ShowInput = True
    .ShowError = True
End With

End Sub

Usunięcie przecinków z listy rozwijalnej. Elementy źródłowe nie mogą mieć przecinków:

'https://stackoverflow.com/questions/30724178/create-data-validation-list-when-some-of-the-values-have-commas

Dim dList As String

dList = Range("B14").Value

'~~> Replace comma with a similar looking character
dList = Replace(dList, ",", Chr(130))

With Range("D14").Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:=dList
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With