Report d'une boucle tableau sur une boucle liste

re,

on le fait assez difficile, je crois. Attendez

Re,

voilà ma solution, testée, en suivant le cours.

'donnees cultures de la parcelle non recoltés
    Dim i%, j%, x%, k%, lig%, col%, cpt%, tb1 As ListObject, tb()
    Set ws1 = Sheets("Cultures")
    Set tb1 = ws1.ListObjects("Culturs")
    Application.ScreenUpdating = False
    'effacement liste précédente
    Me.lstCults.Clear
    'nbre de cultures non récoltees parcelle
    For i = 1 To tb1.ListRows.Count
        If tb1.DataBodyRange(i, 5).Value = Me.parcl.Value And tb1.DataBodyRange(i, 9).Value = "" Then
         cpt = cpt + 1
        End If
    Next i
    ReDim tb(0 To cpt - 1, 1 To 20)
    'MsgBox UBound(tb)
    x = 0
    For i = 1 To tb1.ListRows.Count
        If tb1.DataBodyRange(i, 5).Value = Me.parcl.Value And tb1.DataBodyRange(i, 9).Value = "" Then
             tb(x, 1) = tb1.DataBodyRange(i, 2).Value  'ref
             tb(x, 2) = tb1.DataBodyRange(i, 3).Value  'culture
             tb(x, 3) = tb1.DataBodyRange(i, 4).Value  'variete
             tb(x, 4) = Format(tb1.DataBodyRange(i, 6).Value, "dd/mm/yyyy") 'date semis
             tb(x, 5) = CSng(tb1.DataBodyRange(i, 7).Value)  'semaine semis
             For j = 0 To 4
                If tb1.DataBodyRange(i, (j * 7) + 10).Value <> "" Then
                    tb(x, (j * 3) + 6) = Format(tb1.DataBodyRange(i, (j * 7) + 10).Value, "dd/mm/yyyy") 'date récolte
                    tb(x, (j * 3) + 7) = tb1.DataBodyRange(i, (j * 7) + 11).Value 'semaine recolte
                    tb(x, (j * 3) + 8) = DateDiff("d", tb1.DataBodyRange(i, 6).Value, tb1.DataBodyRange(i, (j * 7) + 10).Value) 'duree
                End If
             Next j
             x = x + 1
        End If
     Next i
     Me.lstCults.list = tb
    'larg cols et 1ere ligne sélectionnee
    If Me.lstCults.ListCount <> 0 Then
        Me.lstCults.ColumnWidths = "30;50;50;50;30; 50; 30; 30;50;30;30;50;30;30;50;30;30;50;30;30" 'largeur cols listbox
        Me.lstCults.Selected(0) = True 'remplissage champs UF avec notes devoirs selon matiére
    End If
    'commentaires
    For j = 0 To Me.lstCults.ListCount - 1
        For i = 1 To tb1.ListRows.Count
            If tb1.DataBodyRange(i, 2).Value = Me.lstCults.list(0, 0) And Me.lstCults.Selected(j) = True Then
                Me.obs.Value = tb1.DataBodyRange(i, 8).Value 'Obs
            End If
        Next i
    Next j
    'revenir à la page de l'index
     Me.MultiPage1.Value = cpt1
fin:
     Application.ScreenUpdating = True

voir macro "Private Sub parcl_change()", elle utilise une autre macro pour créer une liste des numéros de lignes correspondantes avec ce parcelle et eventuellement "récolte". Il y a une liste déroulante maintenant dans "Parcelle". "Jours", je ne savais pas faire la soustraction.

Vous disiez qu'il y a une limite aux nombre de colonnes, je ne le pense pas, vous voulez encore des colonnes supplémentaires ?