Boucles

Bonjour,

J'ai mis l'exemple dans le fichier

J'ai un tableau:

A | A1 | A2-1

A | A1 | A2-2

B | B1 | B2-2

Je cherche une macro qui me permettrait de copier les données de tel sorte

A

A1

A2-1

A2-2 (si les données en colonne 2 identiques)

B

B1

B2-2

la macro du dessous me donne cela

A

A1

A2-1

A

A1

A2-2

B

B1

B2-2

Sub test8()
Dim lig, col As Integer

ligne = 2

    For j = 0 To 3
     lig = 2 + j

           For i = 0 To 0
                col = 1 + i

                valeur1 = Sheets("Feuil1").Cells(lig, col).Value 

                 With Sheets("Feuil2")
                       .Cells(ligne, 1).Value = valeur1
                       ligne = ligne + 1
                  End With
            Next i

            For i = 0 To 0
                col = 2 + i

                valeur2 =Sheets("Feuil1").Cells(lig, col).Value 

                 With Sheets("Feuil2")
                 .Cells(ligne, 2).Value = valeur2
                  ligne = ligne + 1
                 End With
            Next i

            For i = 0 To 0
                col = 3 + i

                valeur3 = Sheets("Feuil1").Cells(lig, col).Value

                       With Sheets("Feuil2")
                      .Cells(ligne, 3).Value = valeur3
                      ligne = ligne + 1
                     End With
                 Next i

    Next j

End Sub

en espérant que quelqu’un pourra m'aider

Bonjour,

Sub Test()
    Dim a$, b$, i%, n%, it%, T()
    With ActiveSheet 'si lancement à partir feuille, sinon à préciser
        n = 4 'dernière ligne du tableau source commençant ligne 2
            'devra être calculée selon méthode adaptée au contexte réel
        For i = 2 To n
            If .Cells(i, 1) <> a Then
                a = .Cells(i, 1): it = it + 1
                ReDim Preserve T(1 To 3, 1 To it): T(1, it) = a
            End If
            If .Cells(i, 2) <> b Then
                b = .Cells(i, 2): it = it + 1
                ReDim Preserve T(1 To 3, 1 To it): T(2, it) = b
            End If
            it = it + 1: ReDim Preserve T(1 To 3, 1 To it): T(3, it) = .Cells(i, 3)
            'si 3e colonne toujours servie, sinon, sous test...
        Next i
        n = n + 10 'juste pour positionner résultats du test, à voir selon destination réelle
        With .Cells(n, 1).Resize(it, 3)
            .Value = WorksheetFunction.Transpose(T)
            .HorizontalAlignment = xlCenter
            With .Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
        End With
    End With
End Sub

Cordialement.

Merci

ça correspond à ma demande,

je vais décoder tout ça...