Couper une ligne complète sous condition

[jc]

Bonsoir à tous,

Je voudrais transférer une ligne complète vers un autre onglet quand une des cellules contient une condition spécifiée :

Exemple en language usuel : si E3 = terminée couper la ligne 3 et insérer là sous la ligne 2 de l'onglet 'action terminées'

Merci d'avance,

JC

 

[pat1545.]

Salut,

si tu cherches le mot 'terminé' voilà:
Option Explicit

Sub depl()
Dim I
Dim Last, Cible, Plg
Sheets('feuil1').Select
Last = Range('E65000').End(xlUp).Row
Set Cible = Sheets('ACTIONS TERMINéES').Range('A1')(1)
For I = Last To 2 Step -1
' ici le mot 'termine' en colonne E
If Cells(I, 5).Value = 'termine' Then
Set Plg = Cells(I, 5).EntireRow
Plg.EntireRow.Interior.ColorIndex = 3
Plg.Copy _
Destination:=Sheets('ACTIONS TERMINéES').Range('A65536').End(xlUp)(2)
Plg.Select
Selection.Delete Shift:=xlUp
End If
Next
End Sub
' il y a surement mieux !!! ;-)
Patrick

 

[Robert]

Bonsoir JC, Patrick, bonsoir le forum,

Patrick a été le plus rapide mais ma prosition (très similaire à la sienne) réagit sur l'événement Change de l'onglet où sont éditées les données. Cela engendre une automatisation de l'action (peut-être pas souhaitable finalement).

Le code ci-dessous est à placer par VBE dans l'élément Worksheet appropriée. Comme tu n'as pas précisé le nom de l'onglet source je te propose Feuil1(Feuil1) par défaut.

Private Sub Worksheet_Change(ByVal Target As Range) 'à chaque changement (édition) dans cet onglet
Dim dest As Range 'déclare la variable dest

'si le changement intervient en dehors de la colonne E, sort de la procédure
If Application.Intersect(Target, Range('E1:E' & Range('E65536').End(xlUp).Row)) Is Nothing Then Exit Sub

'condition : si le texte edité dans la cellule est 'terminée' (accepte aussi les majuscules)
If UCase(Target.Value) = 'TERMINÉE' Then

Set dest = Sheets('action terminées').Cells(Target.Row, 1) 'définit la variable dest (pas de s à actions ???)
dest.Insert Shift:=xlDown 'insère une ligne
Target.EntireRow.Copy Destination:=dest.Offset(-1, 0) 'copie et colle la ligne entière

End If 'fin de la condition
End Sub

p.s. Patrick, tu écris If Cells(I, 5).Value = 'termine' Then... mais JC lui écris terminée. Attention JC, nos codes ne réagissent que sur une valeur bien déterminée qui convient très bien si tu utilises une liste de validation mais qui peut ne pas marcher si l'utilisateur ne tape pas le mot exact.

Message édité par: Robert, à: 08/03/2006 20:15

 

[Climaudo]

Bonsoir JC, Patrick, re Robert, le forum

Robert, j'étais en train de chercher le code et j'ai testé le tien : juste une petite précision pour JC, cette procédure provoque un bug en séléction multiple pour inscrire ou effacer (du moins chez moi, et j'avais rencontré le même problème avec la procédure de MFC de MyDearFriend)

Robert, peux-tu me dire si c'est dû à un problème de configuration chez moi ou si c'est lié à l'événement Change de l'onglet ?

Bonne soirée

Olivier

 

[Gérard DEZAMIS]

Bonsoir JC Patrick et Robert

Dis Robert tu n'aurais pas dans ta malette à malice une petite modif pour ton fichier :
Permettre de trouver la dernière cellule validée dans la feuille 'action terminées' (?) et de placer en dessous les lignes coupées de la feuil1
un truc du genre Range('E3:E'&Range('E65536').en(xlUp).Row ....
Ce qui éviterait d'avoir des 'trous' lors du transfert.
Ta solution d'inséer une ligne ne me plait pas trop ( t'as vu j'suis franc ! Tu es parfois gaulois alors ... )

Merci d'avance
Bonsoir à Tous
@+GD

 

[Robert]

Bonsoir JC, Patrick, Olivier, Gégé la paluche, bonsoir le forum,

Olivier,

le bug n'est pas lié directement à l'événement Change proprement dit mais à Target.Value = ... qui plante quand la sélection est multiple. On peut contourner le problème en interdisant un selection multiple avec :
If Selection.Count > 1 then ActiveCell.Select
ou en prenant en compte toutes les cellules de la selection en remplaçant :
If Target.Value = ...
par
For Each Cel in Selection
If Cel.Value = ...
Next Cel

Mon Gégé,

J'ai cru respecter dans mon code la requête de JC (Jesus Christ ?) mais il te suffit de remplacer :
Set dest = Sheets('action terminées').Cells(Target.Row, 1)
par :
Set dest = Sheets('action terminées').Range('A65536').End(xlup).Offset(1,0)
et de supprimer la ligne :
dest.Insert Shift:=xlDown
qui n'a plus de sens et le tour est joué.

 

[pat1545.]

Salut Gérard et les autres,

dans mon code, Gerard, il va mettre la ligne en bas et non l'insérer avec le code
Plg.Copy _
Destination:=Sheets('ACTIONS TERMINéES').Range('A65536').End(xlUp)(2)

est ce ça que tu demandais ?

Pat

 

[Climaudo]

Bonsoir JC, Patrick, Robert, Gérard, bonsoir le forum,

Robert, merci pour la réponse, je n'avais pas saisi que target ne concernait qu'une cellule.

une info de plus à se souvenir

Bonne soirée

 

[Gérard DEZAMIS]

Merci à tous
Plus particulièrement à Robert et Patrick

Il faut parfois taper plusieurs petits coups pour enfoncer correctement un clou !
ça vient !

En plus Robert s'efforce tjs de bien commenter son code. C'est très agréable et surtout très pratique ! Merci encore
Bonne journée pluvieuse à tous
@+GD

 

[Robert]

Bonjour le fil, bonjour le forum,

Hé Gérard ! Pluvieux toi-même... Ici il fait beau comme tout (na na na na nère...). De la fenêtre de mon bureau je vois l'étang de Thau lisse comme mes fesses (car j'ai la peau lisse aux fesses...) et d'un beau bleu méditérranéen.

 

[Gérard DEZAMIS]

Salut Robert

'La boussole, elle est con : elle indique le Nord alors que tout le monde préfère le Sud !'
On en a ici une preuve flagrante ! Chauvin !

Je vais y apporter un dement _Ti (Non Vincent ne va pas être d'accord) un simple dementi alors...
@+GD [file name=RobertMeteo.zip size=38870]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/RobertMeteo.zip[/file]

 

[Robert]

Bonjour le fil, bonjour le forum,

Pézénas, Pézénas... C'est la ville de Molière et de Bobby Lapointe, ça ! Moi je suis tout près de Sète, la ville de Georges Brassens. Il y pleut des sourires et des pastagas aux comptoirs des cafés...