Discussion :

[Yoyo93220]

Bonjour.
Cette partie de macro a pour but de comparer 2 codes articles en colonne N et P .

Si les 2 codes sont differents , je voudrais que la macro coupe et colle les valeurs des cellules de la colonne P,Q et R et la reporte sur un autre onglet (en rouge sur l'image ).

Suite à ça il faut supprimer les cellules et decaller vers le haut .
Recomparer de nouveau les 2 codes , jusqu'a ce que les 2 codes soientt les mêmes et passer à la ligne suivante

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Do
Range("P2:R2").Select
    Selection.Copy
    Sheets("Feuil1").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Import Tiamp").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
 
Exit Do
Loop Until ActiveCell.FormulaR1C1 = "RC[+2]"

Cette partie de ma macro fonctionne de manière locale sur une ligne , je n'ai pas trouvé comment l'étendre.

Merci d'avance de votre aide.

Cdt

Yoni

[laetitia]

bonjour Yoyo93220 le forum pour faire cela il faut faire une boucle avec conditions
fait une recherche sur

Code :

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

for..next

et

Code :

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

for each..next

[Yoyo93220]

ça ne vas pas créer une rodondance avec la do loop until ?
je ne vois pas trop comment tout mettre en place ( je suis sur vba depuis 1 semaine )

Merci pour ton aide laetitia j'essaie de voir cet élément !

[laetitia]

bonjour Yoyo93220 le forum pas d'avoir bien compris!!!
une approche copy en feuille2 a adapter

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Option Explicit
Sub es()
Dim f As Range, c As Variant
Application.ScreenUpdating = False
Sheets("Feuil1").Activate
For Each c In Sheets("Feuil1").Range("p1:p" & Range("p65536").End(xlUp).Row)
Set f = Sheets("Feuil1").Range("n1:n" & Range("n65536").End(xlUp).Row).Find(c, LookIn:=xlValues, LookAt:=xlWhole)
If f Is Nothing Then
Range("p" & c.Row & ":r" & c.Row).Cut Destination:=Sheets("Feuil2").Range("p65536").End(xlUp)(2)
End If: Next
[p1:r65536].SpecialCells(xlCellTypeBlanks).Columns.Delete
End Sub