Sub Macro1()
Dim dl As Long 'déclare la varialbe dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim dc As Byte 'déclare la variable dc (Dernière Colonne)
Dim col As Byte 'déclare la variable col (COLonne)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim o As Object 'déclare la variable o (Onglet)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Application.ScreenUpdating = False 'masque les changements à l'écran
dl = Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne dl
Set pl = Range("A3:A" & dl) 'définit la plage pl
dc = Cells(3, Application.Columns.Count).End(xlToLeft).Column - 2 'définit la dernière colonne dc
For col = 4 To dc Step 3 'boucle de la colonne 4 à dc par pas de 3
Set pl = Application.Union(pl, Range(Cells(3, col), Cells(dl, col))) 'redéfinit la plage pl
Next col 'prochaine colonne de la boucle
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
If cel.Value <> "" Then 'condition 1 : si la cellule cel n'est pas vide
On Error Resume Next 'gestion des erreur (en cas d'erreur passe à la ligne suivante)
'sélectionne l'onglet dont le nom est la première lettre de la cellule cel
'provoque une erreur si l'onglet n'existe pas
Sheets(Left(cel.Value, 1)).Activate
If Err <> 0 Then 'condition 2 : si une erreur a été générée
Err = 0 'annule l'erreur
Sheets.Add after:=Sheets(Sheets.Count) 'ajoute un onglet en dernière position
ActiveSheet.Name = Left(cel.Value, 1) 'nomme l'onglet avec la première lettre de la cellule cel
End If 'fin de la condition 2
On Error GoTo 0 'annule la gestion des erreurs
Set o = ActiveSheet 'définit l'onglet o
'définit la cellule de destination dest (A1 si A1 est vide sinon, la première cellule vide de la colonne A de l'onglet o)
Set dest = IIf(o.Range("A1") = "", o.Range("A1"), o.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
Range(cel, cel.Offset(0, 2)).Copy dest 'copy cel et ses deux cellules associées et les colle dans dest
End If 'fin de la condition 1
Next cel 'prochaine cellule cel de la boucle
Sheets("Original").Activate 'active l'onglet "Original"
Application.ScreenUpdating = True 'affiche les changements à l'écran
End Sub