Passer horizontal à vertical par couples de cellules

Oups, j'ai oublié le cjoint!

http://cjoint.com/?jDwomhJlNl

Cordialement,
Pierre F.

Bonsoir,

http://cjoint.com/?jDwR0wR87g

En M2:
=DECALER($A$5;ENT((LIGNE()-2)/5);(LIGNE()-2)*2-ENT((LIGNE()-2)/5)*10)

En N2:
=DECALER($A$5;ENT((LIGNE()-2)/5);(LIGNE()-2)*2+1-ENT((LIGNE()-2)/
5)*10)

JB
http://boisgontierjacques.free.fr


On 29 sep, 22:13, "Pierre F." <pfornero...@SPAMhotmail.com> wrote:

Bonjour, bonsoir,

J'ai plusieurs petites plages de 2, 3, 4, 5 ou 6 lignes remplies de
valeurs comme ci-dessous

Valeurs 3
A B C D E F G H I J
1) 3 2) 67 3) 21 4) 65 5) 32
6) 12 7) 132 8) 77 9) 54 10) 8
11)...

Je souhaiterais la transformer comme cela:

Valeurs 3
A B
1) 3
2) 67
3) 21
4) 65
5) 32
6) 12
7) 132
8) 77
...

J'ai essayé "transpose" et 2 macros trouvées dans ce groupe pour pass er
de l'horizontal au vertical... mais rien ne correspond vraiment :-(

Je fais appel à vos lumières.
Merci.

Pierre F.

Essaie ceci :
'---------------------------------
Sub test()
Dim T As Variant
Dim A As Integer, B As Long
Dim X(), C As Long, K As Integer

For Each elt In Array("A5:J6", "A9:J12", "A15:J20")
K = K + 1
With Worksheets("Feuil1")
T = .Range(elt)
For A = 1 To UBound(T, 1)
For B = 2 To UBound(T, 2) Step 2
C = C + 1
ReDim Preserve X(1 To C)
X(C) = T(A, B)
Next
Next
'Où seront copiées les données
.Range("K1").Columns(K).Resize(UBound(X)) = Application.Transpose(X)
End With
Next

End Sub
'---------------------------------


"Pierre F." <pfornerodNO@SPAMhotmail.com> a écrit dans le message de news:
ba100$46feb1e9$55da2ea5$13360@news.hispeed.ch...
Bonjour, bonsoir,

J'ai plusieurs petites plages de 2, 3, 4, 5 ou 6 lignes remplies de
valeurs comme ci-dessous

Valeurs 3
A B C D E F G H I J
1) 3 2) 67 3) 21 4) 65 5) 32
6) 12 7) 132 8) 77 9) 54 10) 8
11)...

Je souhaiterais la transformer comme cela:

Valeurs 3
A B
1) 3
2) 67
3) 21
4) 65
5) 32
6) 12
7) 132
8) 77
...

J'ai essayé "transpose" et 2 macros trouvées dans ce groupe pour passer
de l'horizontal au vertical... mais rien ne correspond vraiment :-(

Je fais appel à vos lumières.
Merci.

Pierre F.

En M2:
ÞCALER($A$5;ENT((LIGNE()-2)/5);(LIGNE()-2)*2-ENT((LIGNE()-2)/5)*10)

En N2:
ÞCALER($A$5;ENT((LIGNE()-2)/5);(LIGNE()-2)*2+1-ENT((LIGNE()-2)/
5)*10)

Super, ça fonctionne... mais "Decaler" reste pour moi une fonction
encore très obscure.

Cordialement,
Pierre F.

Il faut avoir la syntaxe en tête:

Decaler(départ;DecalLigne;DecalColonne;Hauteur;Largeur)

Une autre solution avec une fonction perso matricielle:

http://cjoint.com/?jDxOqLNadn

Function TransposeJB(champ)
Dim temp()
ReDim temp(1 To 2, 1 To (champ.Count) / 2)
For i = 1 To champ.Count - 1 Step 2
k = Int(i / 2) + 1
temp(1, k) = champ(i)
temp(2, k) = champ(i + 1)
Next i
TransposeJB = Application.Transpose(temp)
End Function

Dans le tableur:

=Transposejb(A5:J6)
Valider avec MaJ+Ctrl+entrée


JB


On 29 sep, 22:58, "Pierre F." <pfornero...@SPAMhotmail.com> wrote:

En M2:
=DECALER($A$5;ENT((LIGNE()-2)/5);(LIGNE()-2)*2-ENT((LIGNE()-2)/5)*10)

En N2:
=DECALER($A$5;ENT((LIGNE()-2)/5);(LIGNE()-2)*2+1-ENT((LIGNE()-2)/
5)*10)

Super, ça fonctionne... mais "Decaler" reste pour moi une fonction
encore très obscure.

Cordialement,
Pierre F.

Une autre solution avec une fonction perso matricielle:

Function TransposeJB(champ)
Dim temp()
ReDim temp(1 To 2, 1 To (champ.Count) / 2)
For i = 1 To champ.Count - 1 Step 2
k = Int(i / 2) + 1
temp(1, k) = champ(i)
temp(2, k) = champ(i + 1)
Next i
TransposeJB = Application.Transpose(temp)
End Function

Dans le tableur:

=Transposejb(A5:J6)
Valider avec MaJ+Ctrl+entrée

Merci; c'est un peu ce genre de macro que je cherchais
Mais la solution avec décaler solutionne mieux à mon problème puisque je
peux d'un clic l'appliquer à des centaines de lignes.
La macro demande de définir chaque zone.

Merci encore infiniment.

Cordialement,
Pierre F.

Essaie ceci :
'---------------------------------
Sub test()
Dim T As Variant
Dim A As Integer, B As Long
Dim X(), C As Long, K As Integer

For Each elt In Array("A5:J6", "A9:J12", "A15:J20")
K = K + 1
With Worksheets("Feuil1")
T = .Range(elt)
For A = 1 To UBound(T, 1)
For B = 2 To UBound(T, 2) Step 2
C = C + 1
ReDim Preserve X(1 To C)
X(C) = T(A, B)
Next
Next
'Où seront copiées les données
.Range("K1").Columns(K).Resize(UBound(X)) = Application.Transpose(X)
End With
Next

End Sub
'---------------------------------
Bonsoir,

Cette solution ne correspond pas à ce que j'attends. En fait, les
nombres s'affichent à l'identique dans 3 colonnes (K, L, M).

Merci d'avoir répondu à ma demande.
La solution de JB (Decaler) me conveint très bien.

Cordialement,
Pierre F.