Des colonnes en lignes.. mais par paire

[flomag]

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 :

A ceci:

Dans l'attente de vous lire,

Merci pour votre aide,

Bien à vous,

 

[mapomme]

Bonjour @flomag et bienvenue sur XLD ,

Vous avez très certainement oublié de joindre le fichier avec les données de départ...

A+

 

[flomag]

Mince !

Le voici en pj

Merci !

 

[mapomme]

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:

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

 

[flomag]

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:

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