XL 2016 Réunir les données de plusieurs colonnes non contigües

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TS1 As ListObject 'déclare la variable TS (Tableau Structuré 1)
Dim TS2 As ListObject 'déclare la variable TS (Tableau Structuré 2)
Dim PL1 As Range 'déclare la variable PL1 (PLage 1)
Dim PL2 As Range 'déclare la variable PL2 (PLage 2)
Dim TV As Variant 'déclare la variable TV (Tableau des |Valeurs)
Dim TR() As Variant 'déclare la variable TR (Tableau des Résultats)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (Incrément)
Dim K As Integer 'déclare la variable K (Incrément)

Set O = Worksheets("Feuil1") 'définit l'onglet O
Set TS1 = O.ListObjects("Source") 'définit le tableau structuré TS1
Set PL1 = TS1.DataBodyRange 'définit la plage PL1
Set TS2 = O.ListObjects("Resultat") 'définit le tableau structuré TS2
TV = PL1 'définit la tableau des valeurs TV
For J = 2 To UBound(TV, 2) Step 2 'boucle 1 : sur toutes les colonnes J de TV par pas de deux (en partant de la seconde)
    For I = 1 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I de TV
        If TV(I, J) <> "" Then 'condition : si la donnée ligne I colonne J de TV n'est pas vide
            K = K + 1 'incrémente K
            ReDim Preserve TR(1 To 2, 1 To K) 'redimensionne le tableau des résultats TR (2 lignes, K colonnes)
            TR(1, K) = TV(I, J) 'récupère le nom dans la ligne 1 de TR
            TR(2, K) = TV(I, J + 1) 'récupère le prénom dans la ligne 2 de TR
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 1
Next J 'prochaine colonne de la boucle 2
If TS2.ListRows.Count = 0 Then TS2.ListRows.Add 'si le tableau structuré TS2 ne contient aucune ligne, ajoute une ligne au tableau structuré TS2
TS2.DataBodyRange.Delete 'efface toutes les données du tableau structuré TS2
TS2.Resize Range(Range("I2").Resize(K, 2).Address) 'redimensionne le tableau structuré TS2
Set PL2 = TS2.DataBodyRange 'définit la plage PL2
PL2(1, 1).Resize(K, 2).Value = Application.Transpose(TR) 'renvoie dans la première cellule de la plage PL2, redimensionnée, le tableau TR transposé
End Sub