Chargement Combobox avec plusieurs feuilles de données

Sub RassembleDonnees()
Dim Feuilles As Variant
Dim Colonnes As Variant

'--- Adaptez le nom de chaque feuille ---
Feuilles = Array("Feuil1", "Feuil2", "Feuil3")
'--- Adaptez le N° de chaque colonne ---
Colonnes = Array(2, 2, 4)
'---------------------------------------

Dim S1 As Worksheet
Dim S2 As Worksheet
Dim R As Range
Dim i&
Dim derLig&
Set S2 = ActiveWorkbook.Sheets.Add(after:=Sheets(ActiveWorkbook.Sheets.Count))
For i& = LBound(Feuilles) To UBound(Feuilles)
  Set S1 = ActiveWorkbook.Sheets(Feuilles(i&))
  S1.Activate
  derLig& = S1.Range(Cells(65536, Colonnes(i&)), Cells(65536, Colonnes(i&))).End(xlUp).Row
  Set R = S1.Range(Cells(1, Colonnes(i&)), Cells(derLig&, Colonnes(i&)))
  R.Copy
  S2.Activate
  If i& = 0 Then
    S2.[a1].Select
  Else
    S2.Range("a" & S2.UsedRange.Rows.Count + 1 & "").Select
  End If
  ActiveSheet.Paste
Next i&
S2.[a1].Select
Application.CutCopyMode = False
End Sub

Private Sub UserForm_Initialize()
  Set MonDico = CreateObject("Scripting.Dictionary")
  For Each c In [tab1]
     If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
  Next c
  For Each c In [tab2]
     If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
  Next c
  For Each c In [tab3]
     If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
  Next c
  temp = MonDico.items
  Call tri(temp, LBound(temp), UBound(temp))
  Me.ComboBox1.List = temp
End Sub

Sub tri(a, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call tri(a, g, droi)
  If gauc < d Then Call tri(a, gauc, d)
End Sub

Private Sub UserForm_Initialize()
  Sheets.Add
  [tab1].Copy [A1]
  [tab2].Copy [A65000].End(xlUp).Offset(1, 0)
  [tab3].Copy [A65000].End(xlUp).Offset(1, 0)
  [A:A].Sort key1:=[A1]
  [A:A].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("C1"), Unique:=True
  Me.ComboBox1.List = [C1].CurrentRegion.Value
  Application.DisplayAlerts = False
  ActiveSheet.Delete
End Sub