Discussion :

[lleirce]

Bonjour,

J'ai un petit soucis avec ma macro de suivi transporteur.
Le but de celle ci est de transférer les lignes de l'onglet principal "Suivi" vers 3 autres onglets : "Plis livrés", "Plis livrés avec retard" et "Plis divers".
En modifiant la couleur d'une case, vert, gris ou rouge, la macro transfère les lignes vers l'un des onglets en fonction de cette couleur. La macro fonctionne parfaitement.

Cependant lorsque je travaille dans l'onglet principal "Suivi" je me suis aperçu d'un problèmes que je n'arrive pas à régler :
- en ne modifiant les couleurs des cases que d'une seule couleur et en activant la macro après mon travail, celle ci plante. En fait je suis obligé de modifier au moins une case avec chaque couleur pour que la macro ne plante pas. mais il y a des jours où je ne peux mettre qu'une seule couleur.
La solution serait d'attendre d'avoir au moins une case de chaque couleur, mais pour des raisons de facturation je ne peux pas. Normalement je ne devrais pas être obligé de mettre au moins une case de chaque couleur.
Et lorsqu'elle plante, la macro me supprime le contenu de la case A2 de l'onglet "Suivi" et décale la colonne A d'une case vers le haut.

J'espère avoir été clair dans mon explication.

N'hésitez pas à m'interroger en cas de doute.

Merci par avance de votre aide.

Je mets ci dessous la macro et en fichier joint mon fichier excel.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Private Sub CommandButton21_Click()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TLV As Range 'déclare la variable TLV (Tableau des Ligne Vertes)
Dim TLG As Range 'déclare la variable TLG (Tableau des Ligne Grises)
Dim TLR As Range 'déclare la variable TLR (Tableau des Ligne Rouges)
Dim LI As Integer 'déclare la variable LI (LIgne)
 
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set O = Sheets("Suivi") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, 13).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 13 de l'onglet O
Set TLV = O.Range("A2") 'initialise la plage TLV
Set TLG = O.Range("A2") 'initialise la plage TLG
Set TLR = O.Range("A2") 'initialise la plage TLR
 
For LI = 2 To DL 'boucle sur toutes les lignes de 2 à DL
    'condition : si la couleur de la cellule ligne LI, colonne 13 est grise
    If O.Cells(LI, 13).Interior.Color = RGB(191, 191, 191) Then
        'redéfinit la plage TLG (la ligne LI si TLG ne comporte qu'une seule cellule,
        'sinon, l'union de TLG et de la ligne LI)
        Set TLG = IIf(TLG.Cells.Count = 1, Rows(LI), Application.Union(TLG, Rows(LI)))
    End If 'fin de la condition
 
 
    'condition : si la couleur de la cellule ligne LI, colonne 13 est verte
    If O.Cells(LI, 13).Interior.Color = RGB(146, 208, 80) Then
        'redéfinit la plage TLV (la ligne LI si TLV ne comporte qu'une seule cellule,
        'sinon, l'union de TLV et de la ligne LI)
        Set TLV = IIf(TLV.Cells.Count = 1, Rows(LI), Application.Union(TLV, Rows(LI)))
    End If 'fin de la condition
 
 
    'condition : si la couleur de la cellule ligne LI, colonne 13 est rouge
    If O.Cells(LI, 13).Interior.Color = RGB(255, 0, 0) Then
        'redéfinit la plage TLR (la ligne LI si TLR ne comporte qu'une seule cellule,
        'sinon, l'union de TLR et de la ligne LI)
        Set TLR = IIf(TLR.Cells.Count = 1, Rows(LI), Application.Union(TLR, Rows(LI)))
    End If 'fin de la condition
 
 
 
Next LI 'prochaine ligne de la boucle
TLG.Copy Sheets("Plislivresretard").Cells(Application.Rows.Count, 13).End(xlUp).Offset(1, -12) 'copie et colle la plage TLG dans la cellule A2 de l'onglet "Plislivresretard"
TLG.Delete 'supprime la plage TLG
TLV.Copy Sheets("Plislivres").Cells(Application.Rows.Count, 13).End(xlUp).Offset(1, -12) 'copie et colle la plage TLV dans la cellule A2 de l'onglet "Plislivres"
TLV.Delete 'supprime la plage TLV
TLR.Copy Sheets("Plisdivers").Cells(Application.Rows.Count, 13).End(xlUp).Offset(1, -12) 'copie et colle la plage TLR dans la cellule A2 de l'onglet "Plisdivers"
TLR.Delete 'supprime la plage TLR
Application.ScreenUpdating = True 'Affiche les rafraîchissements d'écran
End Sub

[parmi]

Je pense que tu doives vérifier avant de copier si TLG, TLV et TLR sont vides ou non. Si vide, tu passes au suivant.

[lleirce]

Salut parmi,

Lorsque tu dis TLG, TLV et TLR sont vides ou non, parles tu des onglets ? Si c'est le cas, ceux ci ne doivent surtout pas être vides, sinon je perds tout le travail que j'ai réalisé.

[parmi]

Non, seulement les variables.
Tu pourrais aussi utiliser des variables booléennes que tu mets à True si tu trouves des couleurs.
Avant de copier, tu vérifies si la variable est True ou False.