Transposer 1 ou 2 lignes. [RESOLU]

[Icedarts]

Bonjours à tous,

J'ai un tableau dans lequel je souhaite transposer les adresses et les numéros de telephones qui sont en colonnes.
Parfois il y a le numéro de téléphone et il faut transposer 2 lignes, parfois il n'y a que l'adresse et il faut dans ce cas transposer une ligne.

Je joins un fichier pour être plus clair.

Merci d'avance pour votre aide.

 

[Jack2]

Re : Transposer 1 ou 2 lignes.

Bonjour Icedarts, bonjour le forum,

Je ne suis pas sûr d'avoir compris la question. Le code ci-après transpose, sans les effacer, les adresses et les numéros de téléphone dans les colonnes correspondantes :

Sub Transpose_Lignes()
Dim DerLig As Long
Dim i As Long
Dim ColonneB As String

DerLig = Range("B1", Range("B65535").End(xlUp)).Rows.Count
For i = 2 To DerLig
    If Range("A" & i).Value = "" Then
        ColonneB = Range("B" & i)
        If IsNumeric(ColonneB) Then
            Range("D" & i) = ColonneB
        Else
            Range("C" & i) = ColonneB
        End If
    End If
Next i
End Sub

Si ça ne convient pas est-ce que tu peux mettre le résultat souhaité dans un fichier.
A+ Jack2

 

[Icedarts]

Re : Transposer 1 ou 2 lignes.

Oui pardon avec le résultat souhaité en feuil2.

 

[Jack2]

Re : Transposer 1 ou 2 lignes.

Bonsoir Icedarts,

J'espère que le code te conviendra

A+ Jack2

 

[Icedarts]

Re : Transposer 1 ou 2 lignes.

C'est parfait merci beaucoup!

 

[klin89]

Re : Transposer 1 ou 2 lignes. [RESOLU]

Bonsoir Icedarts, Jack2
Bonsoir le forum,

Une autre façon de procéder, on reste en Feuil1 et on ne tripote que la colonne B.
Je n'ai pas formaté la colonne D (les n° de tél)

Sub Transpose()
Dim dl As Long, x As Long, y As Long, n As Byte, t, plg As Range
With Feuil1
dl = .Range("A" & .Rows.Count).End(xlUp).Row
x = 2
Do
   If x = dl Then
     y = .Range("B" & .Rows.Count).End(xlUp).Row + 1
   Else
     y = .Range("A" & x).End(xlDown).Row
   End If
   n = y - x
   Set plg = .Range("B" & x & ":B" & y - 1)
   'plg.Select
   '.Range("B" & x).Resize(, n).Select
   t = plg
   .Range("B" & x).Resize(, n).Value = Application.Transpose(t)
   .Range("B" & x + 1 & ":B" & y - 1).ClearContents
   x = y
Loop Until x > dl
End With
End Sub

Klin89

 

[Icedarts]

Re : Transposer 1 ou 2 lignes. [RESOLU]

Oui cela fonctionne aussi

 

[Jack2]

Re : Transposer 1 ou 2 lignes. [RESOLU]

Bonjour à tous,

Merci Klin89 pour ton code, j'aime bien appendre de nouvelles notions. Dans la ligne

.Range("B" & x).Resize(, n).Value = Application.Transpose(t)

J'ai compris à quoi sert resize (F1 et tests). Par contre je ne comprends pas Application.Transpose et je n'ai rien trouvé sur internet et la touche F1 ne donne rien. Pourrais tu me donner des liens si tu en as qui expliquent l'utilisation de transpose.

PS
J'ai décomposé avec Z (variant) pour voir le contenu (par F8, espion), mais par contre ça ne marche pas.
Z = .Range("B" & x).Resize(, n).Value
Z = Application.Transpose(T)

Merci

A+ Jack2

 

[klin89]

Re : Transposer 1 ou 2 lignes. [RESOLU]

Bonsoir Jack2

Finalement, j'ai viré la variable n, c'est plus simple.

Sub Transpose()
Dim dl As Long, x As Long, y As Long, t, plg As Range
With Feuil1
dl = .Range("A" & .Rows.Count).End(xlUp).Row
x = 2
Do
   If x = dl Then
     y = .Range("B" & .Rows.Count).End(xlUp).Row + 1
   Else
     y = .Range("A" & x).End(xlDown).Row
   End If
   Set plg = .Range("B" & x & ":B" & y - 1)
   'Remplis le tableau t, des données de la plage
   t = plg
   .Range("B" & x).Resize(UBound(t, 2), UBound(t, 1)).Value = Application.Transpose(t)
   .Range("B" & x + 1 & ":B" & y - 1).ClearContents
   x = y
Loop Until x > dl
End With
End Sub

Sinon un peu de lecture ici :
Ce lien n'existe plus
Un brin d'explications :

'Pour l'exemple
   'A la 1ère itération :
   'je copie B2:B3 dans B2:C2 avec cette instruction
   .Range("B" & x).Resize(UBound(t, 2), UBound(t, 1)).Value = Application.Transpose(t)
   'Inversement, je copie B2:B3 dans B2:B3 avec cette instruction
   .Range("B" & x).Resize(UBound(t, 1), UBound(t, 2)).Value = t
   'Cela n'a pas de sens dans notre cas

En résumé, verticale vers horizontale : je transpose
verticale vers verticale : je ne transpose pas

Sinon, fais une recherche dans Google avec les termes suivants : application.worksheetfunction.transpose suivi de VBA ou array
Klin89

 

[Jack2]

Re : Transposer 1 ou 2 lignes. [RESOLU]

Bonne nuit klin89,

Merci pour le lien et les explications.

Jack2