Fonctions worksheet_change avec plusieurs conditions

Le 03/07/2019 à 12:15

Bonjour,

J'ai un tableau excel qui me permet à l'heure actuelle de couper un ligne dans une feuille et la coller dans une autre via VBA lorsqu'une condition dans une colonne est remplie.

J'aurais besoin de pouvoir faire la même chose avec une seconde colonne et une troisième par la suite.

Au départ je pensais faire deux fonction worksheet_change dans la même feuille mais cela ne fonctionne pas.

Je vous met le code initial et mon code modifié qui je n'arrive pas à mettre à jour.

D'après ce que j'ai lu sur le forum et d'autre forums, il me faudrait un elseif mais je ne parviens pas à le placer correctement :s

Est-ce que vous pourriez m'aider.

Ci dessous le code initial :

Private Sub WorkSheet_Change(ByVal Target As Range)
    Dim LgnS As Range, TblC As Range, lnS%, lnC%, k%
    If Target.Count > 1 Or Target.Row < 5 Or Target.Column <> 5 Then Exit Sub
    If Target.Value = "Dossier classé" Then
        lnS = Target.Row - 4
        Set LgnS = Me.ListObjects(1).DataBodyRange.Rows(lnS)
        k = LgnS.Columns.Count
        With Worksheets("Dossier classés").ListObjects(1)
            If .Range.Cells(2, 1) <> "" Then
                Set TblC = .DataBodyRange: lnC = TblC.Rows.Count + 1
            Else
                Set TblC = .Range.Rows(2): lnC = 1
            End If
        End With
        TblC.Cells(lnC, 1).Resize(, k).Value = LgnS.Value
        LgnS.EntireRow.Delete
    End If

et ici ma tentative de modification :

Private Sub WorkSheet_Change(ByVal Target As Range)
    Dim LgnS As Range, TblC As Range, lnS%, lnC%, k%
    If Target.Count > 1 Or Target.Row < 5 Or Target.Column <> 5 Then Exit Sub

    If Target.Value = "Dossier classé" Then
        lnS = Target.Row - 4
        Set LgnS = Me.ListObjects(1).DataBodyRange.Rows(lnS)
        k = LgnS.Columns.Count
        With Worksheets("Dossier classés").ListObjects(1)
            If .Range.Cells(2, 1) <> "" Then
                Set TblC = .DataBodyRange: lnC = TblC.Rows.Count + 1
            Else
                Set TblC = .Range.Rows(2): lnC = 1
            End If
        End With
        TblC.Cells(lnC, 1).Resize(, k).Value = LgnS.Value
        LgnS.EntireRow.Delete
    End If
    If Target.Count > 1 Or Target.Row < 5 Or Target.Column <> 3 Then Exit Sub
    If Target.Value = "BH" Then
        lnS = Target.Row - 4
        Set LgnS = Me.ListObjects(1).DataBodyRange.Rows(lnS)
        k = LgnS.Columns.Count
        With Worksheets("BH").ListObjects(1)
            If .Range.Cells(2, 1) <> "" Then
                Set TblC = .DataBodyRange: lnC = TblC.Rows.Count + 1
            Else
                Set TblC = .Range.Rows(2): lnC = 1
            End If
        End With
        TblC.Cells(lnC, 1).Resize(, k).Value = LgnS.Value
        LgnS.EntireRow.Delete
    End If

End Sub

Donc en gros, si dans ma colonne 5 il est indiqué dossier classé, la ligne se coupe et colle dans la feuille appelée dossier classé.

Et je voudrais faire la même chose avec la colonne 3, si la cellule contient BH, la ligne se coupe et se colle dans la feuille BH.

Il doit s'agir d'une bêtise de synthaxe mais je ne trouve pas trop où se situe l'erreur.

Merci d'avance

Le 03/07/2019 à 15:45

Bonjour,

Ci-dessous une macro à tester

Private Sub WorkSheet_Change(ByVal Target As Range)
    Dim LgnS As Range, TblC As Range, lnS%, lnC%, k%
    If Target.Count > 1 Or Target.Row < 5 Or Target.Column <> 3 Or Target.Column <> 5 Then Exit Sub

    Select Case Target.Column
      Case 3
          If Target.Value = "BH" Then
              lnS = Target.Row - 4
              Set LgnS = Me.ListObjects(1).DataBodyRange.Rows(lnS)
              k = LgnS.Columns.Count
              With Worksheets("BH").ListObjects(1)
                  If .Range.Cells(2, 1) <> "" Then
                      Set TblC = .DataBodyRange: lnC = TblC.Rows.Count + 1
                  Else
                      Set TblC = .Range.Rows(2): lnC = 1
                  End If
              End With
              TblC.Cells(lnC, 1).Resize(, k).Value = LgnS.Value
              LgnS.EntireRow.Delete
          End If
      Case 5
          If Target.Value = "Dossier classé" Then
              lnS = Target.Row - 4
              Set LgnS = Me.ListObjects(1).DataBodyRange.Rows(lnS)
              k = LgnS.Columns.Count
              With Worksheets("Dossier classés").ListObjects(1)
                  If .Range.Cells(2, 1) <> "" Then
                      Set TblC = .DataBodyRange: lnC = TblC.Rows.Count + 1
                  Else
                      Set TblC = .Range.Rows(2): lnC = 1
                  End If
              End With
              TblC.Cells(lnC, 1).Resize(, k).Value = LgnS.Value
              LgnS.EntireRow.Delete
          End If
    End Select
End Sub

En espèrant que cela t'aide

Le 04/07/2019 à 13:06

Bonjour,

Merci pour la réponse, malheureusement la macro ne semble pas fonctionner.

En fait je suis parti du fichier en pièce jointe dans le sujet suivant (voir la réponse de Mferand), j'aurais sans doute du vous le signaler au départ :

https://forum.excel-pratique.com/viewtopic.php?t=109252

c'est juste que j'ai maintenant rajouté des feuilles avec les contrôleurs et que je voudrais que la ligne se coupe automatiquement dans la feuille ad-hoc.

Le 04/07/2019 à 13:37

Bonjour,

Quand j'aurai un moment ... je regarderai ton fichier ...

Le 04/07/2019 à 14:00

oui pas d'urgence, c'est déjà très gentil de se pencher sur mon problème

Le 05/07/2019 à 14:50

Bonjour,

En regardant ton fichier, je voudrais savoir si BH est, en fait, une nouvelle initiale qui s'ajoute aux 8 contrôleurs existants ?

Si la réponse est positive ... faut-il une solution générique pour tous les contrôleurs ...

ou Uniquement ...une solution pour BH ...?

Le 05/07/2019 à 14:54

En gros BH correspondra à un nouveau contrôleur, qui remplace MG dans la liste.

Mais le but serait d'appliquer la formule pour tous les contrôleurs qui auraient chacun une feuille avec initiale pour le suivi dans le fichier de base.

Le 05/07/2019 à 15:00

Re,

Est-ce-que cela signifie que, dans ton fichier réel .... tu as déjà ajouté tous les onglets pour tous les contrôleurs ...?

Contrairement à la macro existante qui permet l'archivage ... et qui par définition efface totalement la ligne concernée ...

il me semble que, dans le cas des contrôleurs ... il s'agit d'une approche très différente ... une ventilation par personne ...

Est-ce que je me trompe ?

P.S. Félicitations pour le dynamisme de Schaerbeek ...

Le 05/07/2019 à 15:07

Je vais te rajouter le fichier tel qu'il est actuellement en supprimant les données (par soucis de confidentialité ^^)

en gros il faudrait conserver la marcro d'archivage (peu importe la feuille où on se trouvera, que ce soit sur une feuille contrôleur ou sur la liste principale) et en prime pouvoir déplacer directement la ligne concernée dans la feuille dont le contrôleur est responsable et que ce changement se fasse automatiquement lorsque les initiales du contrôleur sont choisies (en sachant très bien qu'une fois que c'est couper-coller on ne revient pas en arrière avec ctrl + z)

EDIT : J'ai oublié de préciser que j'ai rajouté une colonne qui indique la date de la dernière action.

P.S : On fait ce qu'on peut et oui j'aurais du éditer les métadonnées ^^

3suivi-zone-copie.xlsm (142.94 Ko)
Le 05/07/2019 à 15:52

Re,

Je crois que je ne me suis pas exprimé très clairement ...

Autant il parait logique d'utiliser une macro évènementielle pour l'archivage ... car on se trouve en fin de processus ...

autant il parait assez illogique de l'envisager pour l'affectation à un contrôleur ... car, dans ce cas de figure, on se trouve au tout début d'un processus ...

J'espère que cette explication est moins confuse ...

Le 05/07/2019 à 22:45

D'accord mais si je n'utilise pas de macro événementielle pour que la ligne se coupe et colle dans la feuille du contrôleur directement quel serait le type de macro à utiliser ?

Le 06/07/2019 à 08:29
jahsoldier a écrit :

D'accord mais si je n'utilise pas de macro événementielle pour que la ligne se coupe et colle dans la feuille du contrôleur directement quel serait le type de macro à utiliser ?

Bonjour,

Je ne connais pas ton degré de familiarité avec Excel ....

Mais il n'existe que deux types de macros :

1. Macros Standard

2. Macros Evènementielles

Le 06/07/2019 à 12:37

Ben à priori pour moi elle était événementielle, quand on choisit un nom de contrôleur dans la première feuille, la ligne se coupe et colle dans la feuille dédiée à ce contrôleur.

Le 06/07/2019 à 13:12
jahsoldier a écrit :

Ben à priori pour moi elle était événementielle, quand on choisit un nom de contrôleur dans la première feuille, la ligne se coupe et colle dans la feuille dédiée à ce contrôleur.

Re,

Est-ce-que le choix du contrôleur est bien la toute dernière cellule renseignée sur chacune des lignes ....

Le 06/07/2019 à 13:57

Alors soit on classe la ligne directement sans indiquer de contrôleur, soit effectivement c'est la dernière cellule qui sera remplie sur la ligne de la première feuille

Le 09/07/2019 à 09:02

Bon après m'être un peu cassé la tête j'ai finalement trouvé la solution, il fallait que je mette un AND et pas OR dans les conditions du début de fichier.

Du coup problème résolu et le code pour ceux qui chercheraient encore ^^

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LgnS As Range, TblC As Range, lnS%, lnC%, k%
    If Target.Count > 1 Or Target.Row < 5 Or Target.Column <> 5 And Target.Column <> 3 Then Exit Sub
    If Target.Value = "Dossier classé" Then
        lnS = Target.Row - 4
        Set LgnS = Me.ListObjects(1).DataBodyRange.Rows(lnS)
        k = LgnS.Columns.Count
        With Worksheets("Dossier classés").ListObjects(1)
            If .Range.Cells(2, 1) <> "" Then
                Set TblC = .DataBodyRange: lnC = TblC.Rows.Count + 1
            Else
                Set TblC = .Range.Rows(2): lnC = 1
            End If
        End With
        TblC.Cells(lnC, 1).Resize(, k).Value = LgnS.Value
        LgnS.EntireRow.Delete
    ElseIf Target.Value = "BH" Then
        lnS = Target.Row - 4
        Set LgnS = Me.ListObjects(1).DataBodyRange.Rows(lnS)
        k = LgnS.Columns.Count
        With Worksheets("BH").ListObjects(1)
            If .Range.Cells(2, 1) <> "" Then
                Set TblC = .DataBodyRange: lnC = TblC.Rows.Count + 1
            Else
                Set TblC = .Range.Rows(2): lnC = 1
            End If
        End With
        TblC.Cells(lnC, 1).Resize(, k).Value = LgnS.Value
        LgnS.EntireRow.Delete
    ElseIf Target.Value = "CG" Then
        lnS = Target.Row - 4
        Set LgnS = Me.ListObjects(1).DataBodyRange.Rows(lnS)
        k = LgnS.Columns.Count
        With Worksheets("CG").ListObjects(1)
            If .Range.Cells(2, 1) <> "" Then
                Set TblC = .DataBodyRange: lnC = TblC.Rows.Count + 1
            Else
                Set TblC = .Range.Rows(2): lnC = 1
            End If
        End With
        TblC.Cells(lnC, 1).Resize(, k).Value = LgnS.Value
        LgnS.EntireRow.Delete
    ElseIf Target.Value = "EM" Then
        lnS = Target.Row - 4
        Set LgnS = Me.ListObjects(1).DataBodyRange.Rows(lnS)
        k = LgnS.Columns.Count
        With Worksheets("EM").ListObjects(1)
            If .Range.Cells(2, 1) <> "" Then
                Set TblC = .DataBodyRange: lnC = TblC.Rows.Count + 1
            Else
                Set TblC = .Range.Rows(2): lnC = 1
            End If
        End With
        TblC.Cells(lnC, 1).Resize(, k).Value = LgnS.Value
        LgnS.EntireRow.Delete
    ElseIf Target.Value = "JA" Then
        lnS = Target.Row - 4
        Set LgnS = Me.ListObjects(1).DataBodyRange.Rows(lnS)
        k = LgnS.Columns.Count
        With Worksheets("JA").ListObjects(1)
            If .Range.Cells(2, 1) <> "" Then
                Set TblC = .DataBodyRange: lnC = TblC.Rows.Count + 1
            Else
                Set TblC = .Range.Rows(2): lnC = 1
            End If
        End With
        TblC.Cells(lnC, 1).Resize(, k).Value = LgnS.Value
        LgnS.EntireRow.Delete
    ElseIf Target.Value = "MV" Then
        lnS = Target.Row - 4
        Set LgnS = Me.ListObjects(1).DataBodyRange.Rows(lnS)
        k = LgnS.Columns.Count
        With Worksheets("MV").ListObjects(1)
            If .Range.Cells(2, 1) <> "" Then
                Set TblC = .DataBodyRange: lnC = TblC.Rows.Count + 1
            Else
                Set TblC = .Range.Rows(2): lnC = 1
            End If
        End With
        TblC.Cells(lnC, 1).Resize(, k).Value = LgnS.Value
        LgnS.EntireRow.Delete
    ElseIf Target.Value = "SH" Then
        lnS = Target.Row - 4
        Set LgnS = Me.ListObjects(1).DataBodyRange.Rows(lnS)
        k = LgnS.Columns.Count
        With Worksheets("SH").ListObjects(1)
            If .Range.Cells(2, 1) <> "" Then
                Set TblC = .DataBodyRange: lnC = TblC.Rows.Count + 1
            Else
                Set TblC = .Range.Rows(2): lnC = 1
            End If
        End With
        TblC.Cells(lnC, 1).Resize(, k).Value = LgnS.Value
        LgnS.EntireRow.Delete
    ElseIf Target.Value = "YG" Then
        lnS = Target.Row - 4
        Set LgnS = Me.ListObjects(1).DataBodyRange.Rows(lnS)
        k = LgnS.Columns.Count
        With Worksheets("YG").ListObjects(1)
            If .Range.Cells(2, 1) <> "" Then
                Set TblC = .DataBodyRange: lnC = TblC.Rows.Count + 1
            Else
                Set TblC = .Range.Rows(2): lnC = 1
            End If
        End With
        TblC.Cells(lnC, 1).Resize(, k).Value = LgnS.Value
        LgnS.EntireRow.Delete
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column = 5 Then
        Cells(Target.Row, 8) = Now
    End If

 End Sub

Encore merci pour le temps passé et bonne journée.

Je crois qu'il y a moyen d'optimiser le schmilblick mais voilà, ça fonctionne et ça me va pour le moment

Le 09/07/2019 à 10:51

Bonjour,

Content que tu aies pu résoudre ton problème ...

Rechercher des sujets similaires à "fonctions worksheet change conditions"