XL 2010 transfert listbox avec critère

Private Sub CommandButton1_Click()
' Variable
    Dim PL As Range
    Dim dlg As Long
  
' ListeBox1
    Dim TV As Variant

' ListeBox2
    Dim lignes As Variant
    Dim colonnes As Variant

' Base de Colonne A à D
    dlg = Range("A1000").End(xlUp).Row
Set PL = Sheets("data").Range("A2:D" & dlg)

' ListeBox1 = Colonne A
    TV = Application.Index(PL.Value, , 1)
    Worksheets("Resultat").ListBox1.List = TV
    TV = Empty

' A créer pour exemple (Avec 2 colonnes "3 = C et 4 = D")
' ListeBox2 = Colonne C et D
    lignes = Evaluate("row(" & PL.Row & ":" & PL.Rows.Count & ")") ' Ligne 2 = PL.Row  et Derniere Lignes "20" = PL.Rows.Count (19)
    colonnes = Array(3, 4) ' Colonne 3 = C et 4 = D
    Worksheets("Resultat").ListBox2.ColumnCount = UBound(colonnes) + 1 ' Nombres de colonne de la Listebox2
    TV = Application.Index(PL.Value, lignes, colonnes) ' Récupération des données
    Worksheets("Resultat").ListBox2.List = TV ' Transfert dans la listeBox
    lignes = Empty: colonnes = Empty: TV = Empty
End Sub

Private Sub CommandButton1_Click()
Dim n&, o As Object, tablo, liste(), i&
n = Application.CountIf([A:A], Date)
Set o = Sheets("resultat").OLEObjects("ListBox1").Object
o.Clear
If n = 0 Then Exit Sub
tablo = [A1].CurrentRegion.Resize(, 4)
ReDim liste(1 To n, 1 To 2)
n = 0
For i = 2 To UBound(tablo)
    If tablo(i, 1) = Date Then n = n + 1: liste(n, 1) = tablo(i, 3): liste(n, 2) = tablo(i, 4)
Next
'---restitution---
o.List = liste
Sheets("resultat").Activate 'facultatif
End Sub

Private Sub CommandButton1_Click()
' Variable
    Dim PL As Range
    Dim dlg As Long
    Dim calend As Date
    Dim i As Long

' Date Aujourd'hui
    calend = Format(Now, "dd/mm/yyyy")
 
' ListeBox1
    Dim TV() As Variant
    ReDim TV(1 To 1)

' ListeBox2
    Dim lignes() As Variant
    ReDim lignes(1 To 1, 1 To 1)
    Dim colonnes As Variant

' Base de Colonne A à D
    dlg = Range("A1000").End(xlUp).Row
Set PL = Sheets("data").Range("A2:D" & dlg)

' Boucle avec condition pour la date du jour avec la variable Range : Application.Index(PL.Value, , 1)
' Qui contient la colonne A toutes les lignes
' Date du Jour = calend
' Stock dans une variable tableau ci-dessous.
' lignes = Tableau 2 D soit 1 lignes et Plusieurs colonnes / ---->> lignes(1 To 1, 1 To 1)
    For i = LBound(Application.Index(PL.Value, , 1)) To UBound(Application.Index(PL.Value, , 1))
'       Condition si c'est la date du jour enregistrer dans le tableau 2 D
        If Application.Index(PL.Value, , 1)(i, 1) = calend Then
            ' Valeurs
            TV(UBound(TV)) = Application.Index(PL.Value, , 1)(i, 1)
            ReDim Preserve TV(1 To UBound(TV) + 1)
            ' Ligne
            lignes(1, UBound(lignes, 2)) = i
            ReDim Preserve lignes(1 To 1, 1 To UBound(lignes, 2) + 1)
        End If
    Next i
    ' lignes = suprime la derniére colonnes vide.
        ReDim Preserve lignes(1 To 1, 1 To UBound(lignes, 2) - 1)
    ' 'lignes = Transpose le Tableau 2 D en Plusieurs x lignes sur 1 seule colonne
        lignes = Application.Transpose(lignes)
     
' Resultat pour ListeBox1 en relation avec les dates d'aujourd'hui
' ListeBox1 = Colonne A
    Worksheets("Resultat").ListBox1.List = TV

' Résultat pour la ListeBox2 avec les dates d'aujourd'hui pour les 2 colonnes "3 = C et 4 = D"
' Pour les dates d'aujourd'hui
'
' A créer pour exemple = La ListeBox2
' ListeBox2 = Colonne C et D
'   PM ce tableau lignes a était transposé avec Application.Transpose(Ici le tableau = Lignes) ' Les Lignes des dates d'aujourd'hui
    colonnes = Array(3, 4) ' les Colonne 3 = C et 4 = D
    Worksheets("Resultat").ListBox2.ColumnCount = UBound(colonnes) + 1 ' Nombres de colonne de la Listebox2 soit 2 colonnes (C et D)
    TV = Application.Index(PL.Value, lignes, colonnes) ' Récupération des données dans la variable tableau TV
    Worksheets("Resultat").ListBox2.List = TV ' Transfert du tableay TV dans la listeBox3

'   Decharge les variables
    Set PL = Nothing: dlg = Empty: calend = Empty
    i = Empty
    Erase lignes: colonnes = Empty: Erase TV
End Sub

Private Sub CommandButton1_Click()
Dim n&, o As OLEObject, tablo, liste(), i&
n = Application.CountIf([A:A], Date)
Set o = Sheets("resultat").OLEObjects("ListBox1")
o.Object.Clear
If n = 0 Then Exit Sub
tablo = [A1].CurrentRegion.Resize(, 4)
ReDim liste(1 To n, 1 To 2)
n = 0
For i = 2 To UBound(tablo)
    If tablo(i, 1) = Date Then n = n + 1: liste(n, 1) = tablo(i, 3): liste(n, 2) = tablo(i, 4)
Next
'---restitution---
o.Object.List = liste
o.Parent.Activate 'facultatif
End Sub

Private Sub CommandButton1_Click()
' Variable
        dlg = Range("A1000").End(xlUp).Row
        Set PL = Sheets("data").Range("A2:D" & dlg)
        Tbl1 = PL.Value
        clé = Format(Now, "dd/mm/yyyy"): colclé = 1: colRécup = Array(3, 4)
        Tbl = SupArrayCléCol(Tbl1, clé, colclé, colRécup)
        Worksheets("Resultat").ListBox1.ColumnCount = UBound(Tbl, 2) + 1
        Worksheets("Resultat").ListBox1.List = Tbl
End Sub
' ********************************************************************************* '
Function SupArrayCléCol(Tbl, clé, colclé, colRécup)
  n = 0
  For i = LBound(Tbl, 1) To UBound(Tbl, 1)
    If Tbl(i, colclé) = CDate((clé)) Then n = n + 1
  Next i
  j = 0
  Dim Tbl2(): ReDim Tbl2(1 To n, LBound(colRécup) To UBound(colRécup))
  For i = LBound(Tbl, 1) To UBound(Tbl, 1)
    If Tbl(i, colclé) = CDate(clé) Then
      j = j + 1
      For k = LBound(colRécup) To UBound(colRécup): Tbl2(j, k) = Tbl(i, colRécup(k)): Next k
     End If
   Next i
  SupArrayCléCol = Tbl2
End Function