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
 

Membres actuellement en ligne

Statistiques des forums

Discussions
312 104
Messages
2 085 349
Membres
102 869
dernier inscrit
radyreth