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
 

Pièces jointes

  • TEST MACROS.xlsm
    60.3 KB · Affichages: 11

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+
 

Pièces jointes

  • TEST MACROS(1).xlsm
    70.9 KB · Affichages: 15
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 948
Membres
101 850
dernier inscrit
Danigra