Microsoft 365 Lorsque la case passe au statut Terminé alors dans une autre case la date apparait. Puis la ligne se déplace à la fin.

[oceanepla]

Bonjour,

Voici mon fichier, j'aimerais que lorsque la colonne F passe en statut Terminé, la colonne I se remplisse en mettant la date du jour (jour où la modification de la case à été faite). Puis que la ligne 1 passe en position 5 (après les lignes complétés).


Je sais que cela est possible grâce aux macros mais je n'arrive pas à bien coder pour obtenir ce que je souhaite. Le résultat que je souhaite serais que les lignes 1-2-4 se déplacent, donc les deux lignes 3 et 5 se retrouveraient en position 1 et 2

Merci d'avance,



Pouvez-vous m'aider ?

 

[oceanepla]

oulah ! c'est une nouvelle demande, ça ! en plus, elle ne m'a pas l'air si simple que ça à faire ! j'vais y réfléchir, pour essayer de trouver une solution, mais j'peux rien te garantir ; de plus, j'suis déjà débordé actuellement avec d'autres exos et des affaires persos.​

soan

pas de soucis, je comprends, merci en tout cas pour ton aide, si ça ne marche pas ce n'est pas grave

 

[soan]

@Oceane

tu as écrit : « comment faire pour que si le statut repasse à En cours ou en attente la ligne remonte au dessus des lignes terminées ? » ; voici donc la 4ème version qui fait cela en plus. je te laisse faire les tests...​

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim cel As Range, lg1&, lg2&
  With Target
    If .CountLarge > 1 Then Exit Sub
    If .Column <> 7 Then Exit Sub
    lg1 = .Row: If lg1 < 10 Then Exit Sub
    Set cel = .Offset(, 3): Application.ScreenUpdating = 0
    If .Value <> "Terminé" Then
      Application.EnableEvents = 0: cel.ClearContents: [A10].Resize(, 12).Insert 2, 1
      With Cells(lg1 + 1, 1).Resize(, 12): .Copy [A10]: .Delete 3: End With
      [G10].Select: Application.EnableEvents = -1: Exit Sub
    End If
  End With
  Application.EnableEvents = 0: cel = Date: lg2 = Cells(Rows.count, 7).End(3).Row + 1
  With Cells(lg1, 1).Resize(, 12): .Copy Cells(lg2, 1): .Delete 3: End With
  Cells(lg2 - 1, 7).Select: Application.EnableEvents = -1
End Sub

soan

 

[oceanepla]

@Oceane

tu as écrit : « comment faire pour que si le statut repasse à En cours ou en attente la ligne remonte au dessus des lignes terminées ? » ; voici donc la 4ème version qui fait cela en plus. je te laisse faire les tests...​

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim cel As Range, lg1&, lg2&
  With Target
    If .CountLarge > 1 Then Exit Sub
    If .Column <> 7 Then Exit Sub
    lg1 = .Row: If lg1 < 10 Then Exit Sub
    Set cel = .Offset(, 3): Application.ScreenUpdating = 0
    If .Value <> "Terminé" Then
      Application.EnableEvents = 0: cel.ClearContents: [A10].Resize(, 12).Insert 2, 1
      With Cells(lg1 + 1, 1).Resize(, 12): .Copy [A10]: .Delete 3: End With
      [G10].Select: Application.EnableEvents = -1: Exit Sub
    End If
  End With
  Application.EnableEvents = 0: cel = Date: lg2 = Cells(Rows.count, 7).End(3).Row + 1
  With Cells(lg1, 1).Resize(, 12): .Copy Cells(lg2, 1): .Delete 3: End With
  Cells(lg2 - 1, 7).Select: Application.EnableEvents = -1
End Sub

soan

Super merci bcp je vais regarder cela

 

[oceanepla]

Super merci bcp je vais regarder cela

Je dois avoir une petite erreur dans ma formule mais je n'arrive pas à trouver pq.
Si tu as deux minutes pour jeter un œil Soan.

 

[soan]

Bonjour Oceane,

ton fichier en retour.

code VBA adapté à la nouvelle structure de ton fichier :

Option Explicit: Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim cel As Range, lg1&, lg2&
  With Target
    If .CountLarge > 1 Then Exit Sub
    If .Column <> 11 Then Exit Sub
    lg1 = .Row: If lg1 < 10 Then Exit Sub
    Set cel = .Offset(, 2): Application.ScreenUpdating = 0
    If .Value <> "Terminé" Then
      Application.EnableEvents = 0: cel.ClearContents: [A10].Resize(, 16).Insert 2, 1
      With Cells(lg1 + 1, 1).Resize(, 16): .Copy [A10]: .Delete 3: End With
      [K10].Select: Application.EnableEvents = -1: Exit Sub
    End If
  End With
  Application.EnableEvents = 0: cel = Date: lg2 = Cells(Rows.Count, 11).End(3).Row + 1
  With Cells(lg1, 1).Resize(, 16): .Copy Cells(lg2, 1): .Delete 3: End With
  Cells(lg2 - 1, 11).Select: Application.EnableEvents = -1
End Sub

soan

 

[soan]

@Oceane

suite à ton MP, j'ai fait le même job pour la feuille "PA DSC" aussi. la sub Worksheet_Change() est la même ; il fallait juste qu'elle soit placée aussi dans le module de la feuille "PA DSC", et pas seulement dans le module de la feuille "PA Général".​

soan

 

[oceanepla]

@Oceane

suite à ton MP, j'ai fait le même job pour la feuille "PA DSC" aussi. la sub Worksheet_Change() est la même ; il fallait juste qu'elle soit placée aussi dans le module de la feuille "PA DSC", et pas seulement dans le module de la feuille "PA Général".​

soan

Super merci bcp cela fonctionne !!

 

[soan]

ok, donc sujet résolu !

soan