XL 2016 création une liste sous une colonne

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If LCase(Sh.Name) = "bd" Or LCase(Sh.Name) = "liste" Then Exit Sub
Dim d As Object, dd As Object, ddd As Object, tablo, nf$, i&, x$, lig&, a, b, ncol%, resu(), j As Byte, k%
'---tableau source---
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
Set ddd = CreateObject("Scripting.Dictionary")
tablo = [Tableau2] 'tableau structuré
nf = LCase(Sh.Name)
For i = 1 To UBound(tablo)
    If LCase(Left(tablo(i, 4), 31)) = nf Then 'le nom de la dernière feuille est limité à 31 caractères
        x = tablo(i, 2) & " ; " & tablo(i, 3)
        d(x) = ""
        dd(tablo(i, 1)) = ""
        x = x & tablo(i, 1) & tablo(i, 5)
        If Not ddd.exists(x) Then ddd(x) = tablo(i, 6)
    End If
Next i
'---tableau des résultats---
Application.ScreenUpdating = False
If Sh.FilterMode Then Sh.ShowAllData 'si la feuille est filtrée
lig = 4 '1ère ligne de destination
Sh.Rows(lig & ":" & Sh.Rows.Count).Delete xlUp 'RAZ
If d.Count = 0 Then Exit Sub 'sécurité
a = d.keys
b = dd.keys
ncol = dd.Count + 1
'---ligne des dates---
Sh.Cells(lig, 2).Resize(, ncol - 1) = b
Sh.Rows(lig).Font.Bold = True 'gras
'---lignes suivantes---
ReDim resu(1 To 5 * d.Count, 1 To ncol)
For i = 1 To UBound(resu) Step 5
    resu(i, 1) = a((i - 1) / 5)
    resu(i + 1, 1) = "HO to 3G"
    resu(i + 2, 1) = "S1 HO"
    resu(i + 3, 1) = "TAU (connected)"
    resu(i + 4, 1) = "X2 HO"
    For j = 1 To 4
        For k = 2 To ncol
            resu(i + j, k) = ddd(resu(i, 1) & b(k - 2) & resu(i + j, 1))
    Next k, j
    With Sh.Cells(lig + i, 1)
        .Font.Bold = True 'gras
        .Interior.Color = 16777164  'bleu
        .Cells(1, 2).Resize(, ncol - 1).Merge 'fusion
    End With
Next i
'---restitution---
Sh.Cells(lig + 1, 1).Resize(UBound(resu), ncol) = resu
Sh.Cells(lig, 1).Resize(UBound(resu) + 1, ncol).Borders.Weight = xlThin 'bordures
Sh.Columns.AutoFit 'ajuste les largeurs
With Sh.UsedRange: End With 'actualise les barres de défilement
End Sub