Problème avec les boucles DO, LOOP

Bonjour à tous,

J'ai un fichier de salariés qui suivent des formations, chaque salarié suit plusieurs formations. Je souhaiterais voir toutes les formations d'un même salarié sur un seul document personnalisé.

Je parviens (tant bien que mal) à obtenir le nom du salarié et sa 1ère formation sur la feuille en question, mais pas moyen de lui demander de refaire la recherche et afficher les autres formations pour le même salarié.

Je joins un fichier démo.

Un grand merci pour votre aide !

Bonsoir,

Sub CréerPasseport()
    Dim nom$, i&, j&, pprt, wsP As Worksheet
    With Worksheets("formations").Range("A1").CurrentRegion
        .Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes
        Application.ScreenUpdating = False
        For i = 2 To .Rows.Count
            nom = .Cells(i, 1): j = i
            Do While j + 1 <= .Rows.Count
                If .Cells(j + 1, 1) <> nom Then Exit Do
                j = j + 1
            Loop
            pprt = Range(.Cells(i, 2), .Cells(j, 3)).Value2
            Set wsP = Worksheets.Add(after:=Worksheets(Worksheets.Count))
            With wsP
                .Columns(1).ColumnWidth = 16
                .Name = nom: .Range("A1") = "NOM": .Range("A2") = nom
                .Range("A4:B4").Value = Array("FORMATION", "DATE")
                With .Range("A5").Resize(j - i + 1, 2)
                    .Value = pprt: .Interior.Color = vbYellow
                    .Columns(2).NumberFormat = "dd/mm/yyyy"
                End With
                .Range("A4").Resize(j - i + 2, 2).Borders.Weight = xlThin
            End With
            i = j
        Next i
        .Worksheet.Activate
    End With
End Sub

Tu cliques sur le bouton pour tester...

Cordialement.

Bonjour à tous

Une autre approche via PowerQuery : le choix du nom adapte la liste (code VBA qui raffraichit la requête)

MFerrand a écrit :

Bonsoir,

Sub CréerPasseport()
    Dim nom$, i&, j&, pprt, wsP As Worksheet
    With Worksheets("formations").Range("A1").CurrentRegion
        .Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes
        Application.ScreenUpdating = False
        For i = 2 To .Rows.Count
            nom = .Cells(i, 1): j = i
            Do While j + 1 <= .Rows.Count
                If .Cells(j + 1, 1) <> nom Then Exit Do
                j = j + 1
            Loop
            pprt = Range(.Cells(i, 2), .Cells(j, 3)).Value2
            Set wsP = Worksheets.Add(after:=Worksheets(Worksheets.Count))
            With wsP
                .Columns(1).ColumnWidth = 16
                .Name = nom: .Range("A1") = "NOM": .Range("A2") = nom
                .Range("A4:B4").Value = Array("FORMATION", "DATE")
                With .Range("A5").Resize(j - i + 1, 2)
                    .Value = pprt: .Interior.Color = vbYellow
                    .Columns(2).NumberFormat = "dd/mm/yyyy"
                End With
                .Range("A4").Resize(j - i + 2, 2).Borders.Weight = xlThin
            End With
            i = j
        Next i
        .Worksheet.Activate
    End With
End Sub

Tu cliques sur le bouton pour tester...

Cordialement.

Merci beaucoup pour ce coup de main et bonne continuation !

Cordialement.