Sub Macro1()
Dim od As Object 'déclare la variable od (Onglet de Départ)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim d1 As Object 'déclare la variable dl (Dictionnaire 1)
Dim tmp As Variant 'déclare la variable tmp (tableau TeMPoraire)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim i As Integer 'déclare la variable i (incrément)
Dim op As Object 'déclare la variable op (Onglet de Poste)
Dim d2 As Object 'déclare la variable d2 (Dictionnaire 2)
Dim col As Byte 'déclare la variable col (COLonne)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Set od = Sheets("Feuil1") 'définit l'onglet de départ od
dl = od.Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 2 (=B) de l'onglet od
Set pl = od.Range("B2:B" & dl) 'définit la plage pl
Set d1 = CreateObject("Scripting.Dictionary") 'définit le dictionnaire 1
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
d1(cel.Value) = "" 'alimente le dictionnaire
Next cel 'prochaine cellule de la boucle
tmp = d1.keys 'récupère dans le tableau tmp les valeurs uniques du dictionnaire (=sans doublon)
For i = 0 To UBound(tmp) 'boucle 1 : sur toutes les valeurs uniques du tableau tmp (=tous les postes)
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Sheets(tmp(i)).Activate 'active l'onglet tmp(i) (génère une erreur si l'onglet n'existe pas)
If Err <> 0 Then 'condition : si une erreur a été générée
Err = 0 'annule l'erreur
Sheets.Add After:=Sheets(Sheets.Count) 'ajoute une nouvel onglet en dernière position
ActiveSheet.Name = tmp(i) 'renomme l'onglet avec la valeur de tmp(i)
Else 'sinon
GoTo suite 'va à l'étiquette "suite"
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set op = ActiveSheet 'définit l'onglet de poste op
od.Range("A1").AutoFilter Field:=2, Criteria1:=tmp(i) 'filtre l'onglet od sur la colonns 2 (=B) avec tmp(i) comme critère
Set d2 = CreateObject("Scripting.Dictionary") 'définit le dictionnaire d2
For Each cel In pl.Offset(0, -1).SpecialCells(xlCellTypeVisible) 'boucle 2 : sur toutes les cellules visibles de la colonne A de od
d2(cel.Value) = "" 'alimente le dictionnaire
Next cel 'prochaine cellule de la boucle 2
op.Range("A1").Resize(1, d2.Count) = d2.keys 'renvoit la liste des éléments uniques (dates) dans la ligne 1 de l'onglet op
For Each cel In pl.Offset(0, 1).SpecialCells(xlCellTypeVisible) 'boucle 3 sur toutes les cellule visibles de la colonne C de od
'définit la colonne col (recherche la date correspondante dans la ligne 1 de l'onglet op et en récupère la colonne)
col = op.Rows(1).Find(cel.Offset(0, -2).Value, , xlValues, xlWhole).Column
Set dest = op.Cells(Application.Rows.Count, col).End(xlUp).Offset(1, 0) 'définit la cellule de destination dest
dest.Value = cel.Value 'renvoit dans dest la valeur de la cellule cel
Next cel 'prochaine cellule de la boucle 3
suite: 'étiquette
od.Range("A1").AutoFilter 'supprime le filtre automatique dans l'onglet od
Next i 'prochaine valeur unique (=poste) de la boucle 1
End Sub
