XL 2019 Transposer VBA

[undo74]

Bonjour,
Pourriez-vous svp me donner un coup de main comment transposer des données en VBA.
Dans l'onglet DATA "fichier en PJ" les valeurs sont en colonnes je souhaite remettre les valeurs en lignes voir dans l'onglet résultat" fichier en PJ".
Je vous remercie par avance pour aide

 

[mapomme]

Bonsoir @undo74,

Testez ce code :

Sub Ventiler()
Dim t, r, i&, j&, n&
   t = Sheets("Data").Range("a1").CurrentRegion
   ReDim r(1 To 1 + (UBound(t) - 1) * (UBound(t, 2) - 1), 1 To 3)
   n = 1: r(n, 1) = t(1, 1): r(n, 2) = "Zone": r(n, 3) = "VAL %"
   For i = 2 To UBound(t)
      For j = 2 To UBound(t, 2)
         n = n + 1: r(n, 1) = t(i, 1): r(n, 2) = t(1, j): r(n, 3) = t(i, j)
      Next j
   Next i
   Sheets("Résultat").Range("a1").CurrentRegion.ClearContents
   Sheets("Résultat").Range("a1").Resize(UBound(r), 3) = r
   Sheets("Résultat").Range("a1").CurrentRegion.Columns(3).NumberFormat = "0%"
End Sub

 

[undo74]

Bonsoir @undo74,

Testez ce code :

Sub Ventiler()
Dim t, r, i&, j&, n&
   t = Sheets("Data").Range("a1").CurrentRegion
   ReDim r(1 To 1 + (UBound(t) - 1) * (UBound(t, 2) - 1), 1 To 3)
   n = 1: r(n, 1) = t(1, 1): r(n, 2) = "Zone": r(n, 3) = "VAL %"
   For i = 2 To UBound(t)
      For j = 2 To UBound(t, 2)
         n = n + 1: r(n, 1) = t(i, 1): r(n, 2) = t(1, j): r(n, 3) = t(i, j)
      Next j
   Next i
   Sheets("Résultat").Range("a1").CurrentRegion.ClearContents
   Sheets("Résultat").Range("a1").Resize(UBound(r), 3) = r
   Sheets("Résultat").Range("a1").CurrentRegion.Columns(3).NumberFormat = "0%"
End Sub

Bonjour Mapomme,
C'est nickel !
Merci beaucoup pour ton aide