Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim COL As Integer 'déclare la variable COL (Incrément)
Dim KT As Integer 'déclare la variable KT (incrément)
Dim KB As Integer 'déclare la variable KB (incrément)
Dim TLT() As Variant 'déclare la variable TLT (Tableau des Lignes Tapis)
Dim TLB() As Variant 'déclare la variable TLB (Tableau des Lignes Bulles)
Set OS = Worksheets("BASE") 'définit l'onglet OS
Set OD = Worksheets("RESULTATS") 'définit l'onglet OD
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
OD.Columns("B:Y").ClearContents 'efface les ancienne données
KT = 1 'initialise la variable KT
KB = 1 'initialise la variable KB
For COL = 2 To UBound(TV, 2) 'boucle sur toutes les colonnes COL du tableau des valeurs TV (en partant de la secodne)
If TV(2, COL) <> 0 And IsNumeric(TV(2, COL)) = True Then 'condition : si la donnée ligne 2 colonne COL de TV n'est pas nulle
ReDim Preserve TLT(1 To 2, 1 To KT) 'redimensionne le tableau des lignes TLT (2 lignes, KT colonnes)
TLT(1, KT) = TV(1, COL) 'récupère l'entête dans la ligne 1 de TLT
TLT(2, KT) = TV(2, COL) 'récupère la valeur dans la ligne 2 de TLT
KT = KT + 1 'incrémente KT (ajoute une colonne au tableau des lignes TLT)
End If 'fin de la condition
If TV(3, COL) <> 0 And IsNumeric(TV(3, COL)) = True Then 'condition : si la donnée ligne 3 colonne COL de TV n'est pas nulle
ReDim Preserve TLB(1 To 2, 1 To KB) 'redimensionne le tableau des lignes TLB (2 lignes, KB colonnes)
TLB(1, KB) = TV(1, COL) 'récupère l'entête dans la ligne 1 de TLB
TLB(2, KB) = TV(3, COL) 'récupère la valeur dans la ligne 2 de TLB
KB = KB + 1 'incrémente KB (ajoute une colonne au tableau des lignes TLB)
End If 'fin de la condition
Next COL 'prochaine colonne de la boucle
'si KT est supérieure à 1, renvoie le tableau TLT dans la cellule B2 redimensionnée
If KT > 1 Then OD.Range("B2").Resize(2, KT - 1).Value = TLT
'si KB est supérieure à 1, renvoie le tableau TLB dans la cellule B4 redimensionnée
If KB > 1 Then OD.Range("B4").Resize(2, KB - 1).Value = TLB
End Sub