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)
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.