XL 2019 Transposer VBA

undo74

XLDnaute Nouveau
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;)
 

Pièces jointes

  • Exemple.xlsm
    9.4 KB · Affichages: 24
Solution
Bonsoir @undo74,

Testez ce code :
VB:
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

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir @undo74,

Testez ce code :
VB:
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

XLDnaute Nouveau
Bonsoir @undo74,

Testez ce code :
VB:
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
 

Statistiques des forums

Discussions
311 720
Messages
2 081 915
Membres
101 837
dernier inscrit
Ugo