Bonsoir après beaucoup de recherche je n'ai pas trouvé ce dont j'ai besoin j'explique en espérant que vous pourrez me dépannez
j'ai 2 feuil l'une avec tableau nom prénom etc en colonne G j'ai un X qui se coche automatiquement et qui met la ligne en rouge si la personne n'a pas réglé le code est directement mis dans la feuil d'ailleurs il me met débogage dés que je sélectionne la ligne (si vous pouviez me dire ce qui plante):
ensuite une fois la ligne coché avec le X en G je fait ctrld+d pour normalement envoyer vers la feuil archives elles y vont bien avec ce code là:
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 Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Columns("G")) Is Nothing Then Select Case Target Case "X" Target = "" Range("A" & Target.Row & ":R" & Target.Row).Interior.ColorIndex = xlNone Case "" Target = "X" Range("A" & Target.Row & ":R" & Target.Row).Interior.ColorIndex = 3 End Select End If End Sub
je voudrais ensuite supprimé du tableau 1 ces lignes archiver j'ai trouver ce code et voir si je ne pourrais pas fusionner les deux dernier code afin de'n'avoir qu'une seul manip :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14 Sub Archives2() Macro2 Macro ' ' Touche de raccourci du clavier: Ctrl+d Sheets("Archives").Range("A2:R65000").ClearContents ligneRecap = 1 For i = 2 To [a65000].End(xlUp).Row If Cells(i, 1).Interior.ColorIndex = 3 Then ligneRecap = ligneRecap + 1 Cells(i, 1).Resize(1, 18).Copy Sheets("Archives").Cells(ligneRecap, 1) End If Next i End Sub
si je met les deux codes a suivre dans la macro j'ai bien la copie j'ai la suppression mais (trop facile pour moi ) mais cela archives que sur une ligne soit si je met une ligne avec X je clique ligne copier et supp je refait la manip sa le fait mais enlève la ligne que je viens de copier et la remplace j'aimerais que sa aille sur la ligne suivante de façon a récupéré si la personne viens réglé
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6 Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For i = [A65000].End(xlUp).Row To 1 Step -1 If Cells(i, 1) = "xxxx" Then Rows(i).Delete Shift:=xlUp Next i Application.Calculation = xlCalculationAutomatic
Partager