Option Explicit 'oblige à déclarer toutes les variables
Sub Macro1()
Dim r As Object 'déclare la variable r (onglet Result)
Dim ad As Range 'déclare la variable ad (Anciennes Données)
Dim o As Object 'déclare la variable o (Onglet)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim li As Integer 'déclare la variable li (LIgne)
Dim col As Byte 'déclare la variable col (COLonne)
Set r = Sheets("result") 'définit l'onglet r
Application.ScreenUpdating = False 'masque les changements à l'écran
'*************************************************
'efface les anciennes données de l'onglet "result"
'*************************************************
Set ad = r.Range("A1").CurrentRegion 'définit la plage ad
If ad.Rows.Count > 2 Then 'condition : si le nombre de ligne de la plage ad est supérieur à 2
Set ad = ad.Offset(2, 0).Resize(ad.Rows.Count - 2, ad.Columns.Count) 'redéfinit la plage ad (sans les deux premières lignes)
ad.Clear 'efface la plage ad
End If 'fin de la condition
'********************************************************
'extraction des donnés des onglets vers l'onglet "result"
'********************************************************
For Each o In Sheets 'boucle 1 : sur tous les onglets du classeur
If Not o.Name = r.Name Then 'condition 1 : si le nom de l'onglet n'est pas "result"
dl = o.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée de la colonne 1 (=A)
Set pl = o.Range("A2:A" & dl) 'définit la plage pl
For Each cel In pl 'boucle 2 : sur toutes les cellules cel de la plage pl
Select Case Application.WorksheetFunction.CountA(r.Columns(1)) 'agit en fonction du nombre de valeurs dans la colonne A de l'onglet r
Case 0 'cas : aucune valeur
li = 3 'définit la ligne li
Case Else 'tous les autres cas
'condition 2: si la valeur de la cellule n'existe pas dans la colonne 1 de l'onglet r
If r.Columns(1).Find(cel.Value, , xlFormulas, xlWhole) Is Nothing Then
'définit la ligne li (première cellule vide de la colonne A de l'onglet r)
li = r.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Else 'sinon (si la cellule existe)
'définit la ligne li (ligne de la cellule trouvée)
li = r.Columns(1).Find(cel.Value, , xlFormulas, xlWhole).Row
End If 'fin de la condition 2
End Select 'fin de l'action en fonction du nombre de valeurs dans la colonne A de l'onglet r
col = r.Rows(2).Find(cel.Offset(0, 2).Value, , xlValues, xlWhole).Column 'définit la colonne col
If r.Cells(1, col) <> cel.Offset(0, 1).Value Then col = 11 'si le type est différent, col =11 (colonne K)
r.Cells(li, 1).Value = cel.Value 'place dans la cellule de la ligne li et de la colonne 1 la valeur de la cellule cel
r.Cells(li, col) = cel.Offset(0, 3).Value 'place dans la cellule de la ligne li et de la colonne col la valeur en colonne D de la cellule cel
Next cel 'prochaine cellule de la boucle 2
End If 'fin de la condition 1
Next o 'prochain onglet de la boucle 1
'tri par ordre croissant sur la colonne A
r.Range("A3:K" & r.Cells(Application.Rows.Count, 1).End(xlUp).Row).Sort Key1:=r.Range("A3"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Application.ScreenUpdating = True 'affiche les changements à l'écran
End Sub
