Transposer n lignes en 1 ligne bout à bout

bonjour

j'aimerais transformer plusieurs lignes qui correspondent au même sujet mais à des périodes différentes en une seule ligne avec les différentes périodes mises bout à bout, ceci afin d'avoir 1 ligne par sujet (pour pouvoir faire après une analyse statistique dans spss)

merci de votre aide

bonne journée

Bonjour,

C'est la même formule de B19, que tu balades a droite en fonction des périodes et que tu descends, en fonction, du nombre de personnes.

La formule peut être simplifiée si tu mets des 1 de b17 a g17, des 2 de h17 à m17, etc...

Bonsoir DjiDji59430, Astro49, le forum

A tester, résultat en Feuil2 :

Option Explicit

Sub test()
Dim a, i As Long, j As Long, n As Long, col As Byte, w
    a = Sheets("Feuil1").Range("A3").CurrentRegion.Value
    col = UBound(a, 2): n = 1
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then
                n = n + 1: .Item(a(i, 1)) = VBA.Array(n, col)
                For j = 1 To col
                    a(n, j) = a(i, j)
                Next
            Else
                w = .Item(a(i, 1)): w(1) = w(1) + 7
                If UBound(a, 2) < w(1) Then
                    ReDim Preserve a(1 To UBound(a, 1), 1 To w(1))
                End If
                For j = 1 To 7
                    a(w(0), w(1) - 7 + j) = a(i, j + 1)
                Next
                .Item(a(i, 1)) = w
            End If
        Next
    End With
    'Restitution et mise en forme en feuil2
    Application.ScreenUpdating = False
    With Sheets("Feuil2").Cells(1).Resize(n, UBound(a, 2))
        .CurrentRegion.Clear
        .Value = a
        If UBound(a, 2) > col Then
            With .Offset(, 1).Resize(1, 7)
                .AutoFill .Resize(, UBound(a, 2) - col + 7), 1
            End With
        End If
        .Font.Name = "calibri"
        .Font.Size = 10
        .VerticalAlignment = xlCenter
        .Borders(xlInsideVertical).Weight = xlThin
        .BorderAround Weight:=xlThin
        With .Rows(1)
            .Font.Size = 11
            .BorderAround Weight:=xlThin
            With .Offset(, 1).Resize(, .Columns.Count - 1)
                .Interior.ColorIndex = 44
            End With
        End With
        With .Columns(1).Offset(1).Resize(.Rows.Count - 1)
            .Interior.ColorIndex = 19
        End With
        .Columns.ColumnWidth = 12
        .Parent.Activate
    End With
    Application.ScreenUpdating = True
End Sub

klin89

Bonjour le forum,

j'aime bien ce code avec dico, j'avais essayé péniblement sans y arriver parce que certain qu'un dico -dont je suis fan sans pouvoir chaque fois l'utiliser - était la solution vba

Bravo Klin !

P.