Des colonnes en lignes.. mais par paire

flomag

XLDnaute Nouveau
Bonjour à tous,

Je me permets de vous soumettre une demande, j'aimerai mettre toutes les colonnes après B en dessous des lignes A & B mais en le faisant par paire ex :

A B
C D
E F
G H
.....

Pensez-vous que cela est possible ?

Je vous mets 2 screenshots pour mieux visualiser le besoin :

Fichier de départ :

1030714


A ceci:

1030715


Dans l'attente de vous lire,

Merci pour votre aide,

Bien à vous,
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re @flomag,

Voir le fichier joint en retour. Cliquez sur le bouton Hop!
Le résultat est sur la feuille "Res".
Le code VBA se trouve dans le Module1:
VB:
Sub ventiler()
Dim t, i&, j&, n&
t = Sheets("data").Range("a1").CurrentRegion
ReDim r(1 To UBound(t) * UBound(t, 2) / 2 + 1, 1 To 3)
For j = 1 To UBound(t, 2) Step 2
  For i = 2 To UBound(t)
    If t(i, j) <> "" Then
      n = n + 1: r(n, 1) = t(1, j)
      r(n, 2) = t(i, j): r(n, 3) = t(i, j + 1)
    End If
  Next i
Next j
With Sheets("Res").Range("a1")
  .Clear
  .Resize(UBound(r), UBound(r, 2)) = r
End With
End Sub
 

Fichiers joints

flomag

XLDnaute Nouveau
Re @flomag,

Voir le fichier joint en retour. Cliquez sur le bouton Hop!
Le résultat est sur la feuille "Res".
Le code VBA se trouve dans le Module1:
VB:
Sub ventiler()
Dim t, i&, j&, n&
t = Sheets("data").Range("a1").CurrentRegion
ReDim r(1 To UBound(t) * UBound(t, 2) / 2 + 1, 1 To 3)
For j = 1 To UBound(t, 2) Step 2
  For i = 2 To UBound(t)
    If t(i, j) <> "" Then
      n = n + 1: r(n, 1) = t(1, j)
      r(n, 2) = t(i, j): r(n, 3) = t(i, j + 1)
    End If
  Next i
Next j
With Sheets("Res").Range("a1")
  .Clear
  .Resize(UBound(r), UBound(r, 2)) = r
End With
End Sub
Super ça marche !!

Merci bcp bcp :)

A bientôt :)
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas