Explication code transposer colonne en ligne

Bonjour à tous,

J 'ai trouvé un code, pour transposer des colonnes en lignes, que j 'aimerais adapter, malheureusement , il n 'est pas commenté..

 Dim lig As Long, n As Long, memlig As Long
    n = 1
    'Application.ScreenUpdating = False
    For lig = 2 To [A65536].End(xlUp).Row
        If Cells(lig, 1) = Cells(lig - 1, 1) Then
             Cells(lig, 2).Resize(1, 3).Copy Destination:=Cells(memlig, 3).Offset(0, (n * 3))
            n = n + 1
        Else
           n = 1
            memlig = lig
        End If
    Next lig
    For lig = [A65536].End(xlUp).Row To 2 Step -1
        If Cells(lig, 1) = Cells(lig - 1, 1) Then
            Cells(lig, 1).EntireRow.Delete
        End If
    Next lig
    'Application.ScreenUpdating = True

J'ai du mal a comprendre cette partie du code

  If Cells(lig, 1) = Cells(lig - 1, 1) Then
             Cells(lig, 2).Resize(1, 3).Copy Destination:=Cells(memlig, 3).Offset(0, (n * 3))
            n = n + 1
        Else
           n = 1
            memlig = lig
        End If

Le code copie bien les trois colonnes de la premières ligne mais ensuite, il ne copie que les deux première colonnes de la ligne suivante..

Merci pour votre aide et vos explications.

Greg

bonjour

Sub Compile()
    Dim lig As Long, n As Long, memlig As Long
    n = 1
    'Application.ScreenUpdating = False
    'on boucle sur les lignes utiles
    For lig = 2 To [A65536].End(xlUp).Row
        If Cells(lig, 1) = Cells(lig - 1, 1) Then 'si même valeur en colonne 1 de la ligne actuelle et la ligne précédente
      'copie des cellules 2,3,4 (à partir de 2 par groupe de 3) sur la ligne memlig à la suite des groupes de 3 cellules déjà copiées
             Cells(lig, 2).Resize(1, 3).Copy Destination:=Cells(memlig, 3).Offset(0, (n * 3))
            n = n + 1 ' on incremente le groupe de cellules copiées
        Else
           n = 1 'valeur différente en colonne 1
            memlig = lig 'nouvelle ligne
        End If
    Next lig
    'suppression des lignes inutiles
    For lig = [A65536].End(xlUp).Row To 2 Step -1
        If Cells(lig, 1) = Cells(lig - 1, 1) Then
            Cells(lig, 1).EntireRow.Delete
        End If
    Next lig
    Application.ScreenUpdating = True
End Sub

si tu as 4 colonnes à copier tu devrais modifier ceci

Cells(lig, 2).Resize(1, 3).Copy Destination:=Cells(memlig, 3).Offset(0, (n * 3))

en ceci

Cells(lig, 2).Resize(1, 4).Copy Destination:=Cells(memlig, 2).Offset(0, (n * 4))

Bonjour,

plutôt que d'essayer d'utiliser un code que tu n'es pas sûr d'être adapté à ton besoin, explique plutôt ce que tu veux faire.
eric

Merci à vous 2,

Je vais essayé de me débrouiller avec ce code et l 'adapter.. Je me permettrais de revenir vers vous si ça ne fonctionne vraiment pas.

Encore merci pour votre aide

Greg