Private Sub CommandButton1_Click() 'bouton "
Dim i As Byte 'déclare la variable i (Incrément)
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 o As Object 'déclare la variable o (Onglet)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
ActiveCell.Select 'enlève le focus au bouton
Application.ScreenUpdating = False 'masque les changements à l'écran
'suppression des anciennes données
For i = 2 To Sheets.Count 'boucle sur tous les onglets (en partant du second)
Sheets(i).Cells.Clear 'efface toutes les anciennes données
Sheets("Alertes").Range("A12:G12").Copy 'copie la ligne 12
Sheets(i).Range("A1").PasteSpecial (xlPasteColumnWidths) 'colle dans la cellule A1 de l'onglet en cours la largeur des colonnes
Sheets(i).Range("A1").PasteSpecial (xlPasteAll) 'colle dans la cellule A1 de l'onglet en cours le contenu
Next i 'prochain onglet de la boucle
'dispachting des lignes dans leur onglet respectif
With Sheets("Alertes") 'prend en compte l'onglet "Alertes"
dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne dl
Set pl = .Range("A13:A" & dl) 'définit la plage pl
End With 'fin de la prise en compte l'onglet "Alertes"
For Each cel In pl 'boucle : sur toutes les cellules cel de la plage pl
On Error Resume Next 'gestion des erreurs (si erreur passe à la ligne suivante)
Set o = Sheets(CStr(cel.Value)) 'définit l'onglet o (si cet onglet n'existe pas, provoque une erreur)
If Err <> 0 Then 'condition 1 : si une erreur a été générée
Err = 0 'annule l'erreur
'condition 2 : si "oui" au message
If MsgBox("L'onglet " & cel.Value & " n'existe pas ! Voulez-vous le créer ?", vbYesNo, "Attention !") = vbYes Then
Sheets.Add 'ajoute un onglet
ActiveSheet.Name = cel.Value 'renomme l'onglet
ActiveSheet.Move before:=Sheets("Récap") 'place l'onglet en avant dernière position
Set o = Sheets(CStr(cel.Value)) 'définit l'onglet o
End If 'fin de la condition 2
End If 'fin de la condition 1
Set dest = o.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination dest
cel.EntireRow.Copy dest 'copie la ligne de la cellule cel et la colle dans dest
Next cel 'prochaine cellule cel de la boucle
'préparation au tri et tri des onglets "S"
For i = 2 To Sheets.Count - 1 'boucle 1 sur tous les onglets (en partant du second jusqu'a l'avant-dernier)
With Sheets(i) 'prend en compte l'onglet en cours
For Each cel In .Range("A2:A" & .Cells(Application.Rows.Count, 1).End(xlUp).Row) 'boucle 2 : sur toutes les cellules cel de la coloone A
Select Case UCase(cel.Offset(0, 6).Value) 'agit en fonction de la valeur (en majuscule) de la cellule de la colonne 6 (G)
Case "ROUGE" 'cas "ROUGE"
cel.Offset(0, 7).Value = 1 'place 1 en colonne H
Case "ORANGE" 'cas "ORANGE"
cel.Offset(0, 7).Value = 2 'place 2 en colonne H
Case "JAUNE" 'cas "JAUNE"
cel.Offset(0, 7).Value = 3 'place 3 en colonne H
Case Else 'n'importe quel autre cas
cel.Offset(0, 7).Value = 4 'place 4 en colonne H
End Select 'fin de l'action en fonction de ...
Next cel 'prochaine cellule cel de la boucle 2
'tri en fonction du numéro de la colonne H
.Range("A1").CurrentRegion.Sort Key1:=.Range("H2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
.Columns(8).Clear 'supprime le contenu de la colonne H
Set dest = Sheets("Récap").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'redéfinit la cellule de destination
Set pl = .Range("A1").CurrentRegion 'redéfinit la plage pl
If pl.Rows.Count > 1 Then 'condition : si la plage pl contient plus d'une seule ligne
Set pl = pl.Offset(1, 0).Resize(pl.Rows.Count - 1, pl.Columns.Count) 'redéfinit la plage pl (sans les étiquettes en première ligne)
pl.Copy dest 'copie la plage pl dans dest
End If 'fin de la condition
End With 'fn de la prise en compte de l'onglet en cours
Next i 'prochain onglet de la boucle 1
'préparation au tri et tri de l'onglet "Récap"
With Sheets("Récap") 'prend en compte l'onglet "Récap"
For Each cel In .Range("A2:A" & .Cells(Application.Rows.Count, 1).End(xlUp).Row) 'boucle sur toutes les cellules cel de la colonne A
'place en colonne H "AAA" ou "CBCB" en pontion de la première lettre de la cellule en colonne C
cel.Offset(0, 7).Value = IIf(Left(cel.Offset(0, 2).Value, 1) = "A", Left(cel.Offset(0, 2).Value, 3), Left(cel.Offset(0, 2).Value, 4))
Next cel 'prochaine cellule de la boucle
' Set pl = .Range("A1").CurrentRegion 'redéfinit la plage pl
' If pl.Rows.Count > 1 Then 'condition : si la plage pl contient plus d'une seule ligne
' Set pl = pl.Offset(1, 0).Resize(pl.Rows.Count - 1, pl.Columns.Count) 'redéfinit la plage pl (sans les étiquettes en première ligne)
' pl.Copy dest 'copie la plage pl dans dest
' End If 'fin de la condition
.Range("A1").CurrentRegion.Sort Key1:=.Range("A2"), Order1:=xlAscending, Key2:=.Range("H2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
.Columns(8).Clear 'supprime le contenu de la colonne H
End With 'fin de la prise en compte de l'onglet "Récap
Application.ScreenUpdating = True 'afficge les changements à l'écran
End Sub
