XL 2013 [Résolu] Erreur: l'indice n'appartient pas à la sélection avec tableau

ReDim Tbl(1 To UBound(Bd, 2), 1 To 1)

For k = 4 To 8
        If Sheets(k).Activate Then
            With Sheets(k)
                Bd = .Range("a2:h" & .Range("h" & Rows.Count).End(xlUp).Row)
            End With
        Else
            Exit For
        End If
    Next k

        With ListBox1
            .ColumnCount = 8
            .ColumnWidths = "80;80;80;120;100;100;60;60"
            .List = Bd
            .Clear
        End With

Private Sub Resultats_Eleves()
Dim d1 As Object, d2 As Object, class As String, WsB As Worksheet, Ws As Worksheet
Dim Tablo As Variant, Tbl1, Tbl2

    Set d1 = CreateObject("Scripting.Dictionary"): Set d2 = CreateObject("Scripting.Dictionary")

    class = TextBox3.Value

    With WsB
        Tablo = .Range("a2:u" & .Range("u" & Rows.Count).End(xlUp).Row)
    End With

    On Error Resume Next

    For i = LBound(a) To UBound(a)
        If Tablo(i, 13) = "Réussi" And Tablo(i, 7) = class Then
            d1(i) = Array(Tablo(i, 2), a(i, 7), Tablo(i, 8), Tablo(i, 9), Tablo(i, 10), Tablo(i, 11), Tablo(i, 12), Tablo(i, 13))
        End If
        If a(i, 13) = "Echoué" And a(i, 7) = class Then
            d2(i) = Array(Tablo(i, 2), a(i, 7), Tablo(i, 8), Tablo(i, 9), Tablo(i, 10), Tablo(i, 11), Tablo(i, 12), Tablo(i, 13))
        End If
    Next i

    For Each Ws In ThisWorkbook.Sheets
        If Ws.Name = class Then Ws.Activate
    Next Ws
    Tbl1 = Application.Transpose(Application.Transpose(d1.items))
    Tbl2 = Application.Transpose(Application.Transpose(d2.items))

    ActiveSheet.Range("a2").Resize(UBound(Tbl1), UBound(Tbl1, 2)) = Tbl1
    Sheets("6ème").Range("a2").Resize(UBound(Tbl2), UBound(Tbl2, 2)) = Tbl2

    Set d1 = Nothing
    Set d2 = Nothing
End Sub

 If Sheets(k).Activate Then

With ListBox1
            .ColumnCount = 8 'on définit le nombre de colonnes
            .ColumnWidths = "80;80;80;120;100;100;60;60" 'on définit la  largeur des Colonnes
            .List = Bd        '  Ici On charge
            .Clear               '  la On vide ,,,  à déplacer sous With ListBox1
  End With

Private Sub Lister()
Dim DerLgn As Long
Dim n As Long
    n = 0
    With ActiveSheet
     DerLgn = .Cells(.Rows.Count, 8).End(xlUp).Row
              Bd = .Range("a2:h" & DerLgn).Value
    End With
  
    For i = LBound(Bd) To UBound(Bd)
        If Bd(i, 1) Like CbEleve & "*" Then
           n = n + 1: ReDim Preserve Tbl(1 To UBound(Bd, 2), 1 To n)
            For k = 1 To UBound(Bd, 2)
             Tbl(k, n) = IIf(k = 6, Replace(Bd(i, k), ",", "."), Bd(i, k))
            Next k
        End If
    Next i
With ListBox1
     .Clear                'On efface
     .Column = Tbl 'On colle le Tableau
End With
End Sub

    Classe = Array("5ème", "6ème", "7ème", "8ème", "9ème")
    For Each Sh In Sheets(Classe)
        Bd = Sh.Range("a2:h" & Sh.Range("h" & Rows.Count).End(xlUp).Row)
    Next Sh