Aide sur les macros

Nadia

XLDnaute Nouveau
Bonjour,

J'aurais besoin de votre aide, svp, je dois effectuer une macro pour récupérer des données qui sont situées dans un premier onglet (Habilitations) et les basculer dans l'onglet (Synthèse). Jusque ici cela peut paraître simple.

En effet, je dois regrouper tout les agents ayant la même catégorie de formation en stipulant le nom de la formation ainsi que la date de validité de cette dernière (voir feuille Synthèse). Tout en sachant qu'un agent peut être dans la même catégorie avec un autre intitulé de formation.

Il faudrait donc créer une nouvelle ligne avec le nom de l'agent si il y a une autre formation dans la même catégorie.

Thanks
 

Fichiers joints

job75

XLDnaute Barbatruc
Bonsoir Nadia, bienvenue sur XLD,

Voyez le fichier joint et cette macro, plus compliquée qu'on pouvait le penser :
VB:
Private Sub Worksheet_Activate()
Dim tablo, ub&, resu(), i&
tablo = Sheets("HABILITATIONS").[A1].CurrentRegion.Offset(1).Resize(, 5) 'matrice, plus rapide
ub = UBound(tablo)
ReDim resu(1 To ub, 1 To 6)
'---traitement des tableaux VBA---
For i = 1 To ub
    resu(i, 2) = tablo(i, 2)
    If tablo(i, 3) = "AMI" Then
        resu(i, 3) = tablo(i, 4)
        resu(i, 4) = tablo(i, 5)
    Else
        resu(i, 5) = tablo(i, 4)
        resu(i, 6) = tablo(i, 5)
    End If
Next
'---restitution et 1er tri sur les agents---
Application.ScreenUpdating = False
Range("A6:F" & Rows.Count).Delete xlUp 'RAZ
[A6].Resize(ub, 6) = resu
[A6].Resize(ub, 6).Sort [B6], xlAscending, Header:=xlNo
'---2ème tri du tableau (moitié gauche)---
[B6].Resize(ub, 3).Sort [B6], xlAscending, [D6], , xlAscending, Header:=xlNo
'---3ème tri du tableau (moitié droite)---
[B6].Resize(ub).Copy: [E6].Insert xlToRight 'copie et insertion d'une colonne auxiliaire
[E6].Resize(ub, 3).Sort [E6], xlAscending, [G6], , xlAscending, Header:=xlNo
[E6].Resize(ub).Delete xlToLeft 'suppresion de la colonne auxiliaire
'---suppression des lignes vides
[G6].Resize(ub).Insert xlToRight 'insertion d'une nouvelle colonne auxiliaire
[G6].Resize(ub).FormulaR1C1 = "=1/SIGN(COUNTA(RC3:RC6))"
[G6].Resize(ub) = [G6].Resize(ub).Value 'suppression des formules
[A6].Resize(ub, 7).Sort [G6], xlAscending, Header:=xlNo 'ti pour accélérer
On Error Resume Next 'si aucune SpecialCell
Intersect([A:G], [G6].Resize(ub).SpecialCells(xlCellTypeConstants, 16).EntireRow).Delete xlUp
[G6].Resize(ub).Delete xlToLeft 'suppression de la colonne auxiliaire
'---formats---
[A1].CurrentRegion.Borders.Weight = xlThin
Columns("B:F").AutoFit 'ajustement largeurs
With UsedRange: End With 'actualise les barres de défilement
End Sub
Elle est à placer dans le code de la feuille "Synthèse" (clic droit sur l'onglet et Visualiser le code).

A+
 

Fichiers joints

Dernière édition:

Nadia

XLDnaute Nouveau
Bonjour,

Merci beaucoup pour votre réponse, qui colle parfaitement à mon tableau.

Thankssss
 

Discussions similaires


Haut Bas