Transposer à l'horizontal

Bonjour,

Voilà, j'explique mon problème.

J'ai des données en verticale que je souhaite transposer à l'horizontale.

Les données ont un nombre de caractères définis, soit 13 ou 23

et je voudrais concatener les données de façon à avoir ma cellule à 13 suivie des cellules à 23 et ainsi de suite.

Le nombre de données est importante et je voudrais éviter les copier/coller transposé

Merci d'avance pour vos réponses.

exple :

1111111111111

30000788888888888881978

30002006130000691930D49

1234567890123

20022222222222222222111

30000000000000000000001

10000000000055555555555

0004567898881

10000110000055555555555

Bonjour Noucho, bonjour le forum,

Pour la transposition ce petit bout de code à adapter :

Sub Macro1()
Dim TC As Variant
TC = Range("A1").CurrentRegion
Range("B1").Resize(1, UBound(TC, 1)).Value = Application.Transpose(TC)
End Sub

Pour la concaténation, j'avoue que je n'ai rien compris à tes explications...

En fait, je voudrais ce résultat :

1111111111111;30000788888888888881978;30002006130000691930D49

1234567890123;20022222222222222222111;30000000000000000000001;10000000000055555555555

En premier,la cellule a 13 caracteres suivie des cellules de 23 caracteres et ainsi de suite.

J'ai tenté le code mais ça ne fonctionne pas ...

Bonsoir à tous,

Tes données à partir de A1 :

Option Explicit

Sub Transpose_Concatenate()
Dim myArea As Range, myAreas As Areas, temp As String, b(), n As Long
    ReDim b(1 To 1)
    With Range("a1", Range("a" & Rows.Count).End(xlUp)).Offset(, 1)
        .Formula = "=if(len(a1)=23,1,"""")"
        .Value = .Value
    End With
    With Range("b1", Range("b" & Rows.Count).End(xlUp))
        On Error Resume Next
        Set myAreas = .SpecialCells(2).Areas
        If myAreas Is Nothing Then Exit Sub
        On Error GoTo 0
        For Each myArea In myAreas
            If myArea.Rows.Count > 1 Then
                temp = Join(Evaluate("transpose(" & myArea.Offset(, -1).Address & ")"), ";")
            Else
                temp = myArea.Offset(, -1).Value
            End If
            n = n + 1
            ReDim Preserve b(1 To n)
            With myArea.Resize(1).Offset(, -1)
                b(n) = .Offset(-1).Value & ";" & temp
            End With
        Next
    End With
    Range("d1").Resize(n) = Application.Transpose(b)
    Columns("b").Delete
End Sub

klin89