XL 2013 Extension macro a plusieurs lignes

[altra83]

Bonjour !

Je reviens vers vous car je n'arrive pas a faire quelque chose qui, je pense, ne doit pas être très compliqué :x

Il y a quelques jours, j'ai fais une demande sur ce forum pour une macro qui decale les cellules d'une ligne par rapport a une autre ([MACRO 1] ici, supprime "pomme" en L1, car = à G1 et decale les autres fruit pour que R1 soit vide)

Le problème, c'est que ça ne marche que sur une ligne, et j'aimerai avoir la même macro mais qui me ferait le travail sur toutes les lignes (suppression + décalage lorsque doublon, en un clic, chaque ligne étant indépendante l'une de l'autre, j'aimerai aussi si possible que cela s'applique a toutes les lignes, vu que je compte rajouter regulierement des lignes dans le tableau qui sera concerné par cette macro), exactement comme la [macro 1]

Je vous remercie encore une fois d'avance

 

[Joël GARBE]

Bonjour Altra,

C'eût été plus judicieux de mettre la macro dans le fichier joint plutôt que dans un autre fichier de ton disque dur !

 

[pierrejean]

Bonjour altra
Salut joël Garbe

Un essai

 

[altra83]

Débutant en VBA et macro jusqu'au bout du clavier :x

Je met le nouveau doc en PJ, normalement ca devrait être bon !

 

[altra83]

Bonjour altra
Salut joël Garbe

Un essai

C'est impeccable, cependant, est-il possible de bloqué le decalage apres la colonne R ? (car j'ai d'autre donné dans mon tableau, et je ne voudrais pas les décaler :x)
Sinon, c'est exactement la macro que je recherchais !

 

[Joël GARBE]

Re,

Ajoute une boucle à la macro... et adapte le reste...

Sub decalage_WL_TEST()
Dim i As Long
For i = 1 To 8
  Set c = Range("I" & i & ":" & Cells(i, Columns.Count).End(xlToLeft).Offset(0, 1).Address).Find(Range("G" & i), LookIn:=xlValues, lookat:=xlWhole)
  If Not c Is Nothing Then
     For n = c.Column To Cells(i, Columns.Count).End(xlToLeft).Column Step 2
        Cells(i, n) = Cells(i, n + 2)
     Next
  End If
Next
End Sub

 

[pierrejean]

Re
Mon code:

Sub test()
For m = 1 To Range("F" & Rows.Count).End(xlUp).Row
Set c = Range("I" & m & ":R" & m).Find(Range("G" & m), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
   For n = c.Column To 18 Step 2
   If n <> 18 Then
      Cells(m, n) = Cells(m, n + 2)
   Else
      Cells(m, n) = ""
   End If
   Next
End If
Next
End Sub

 

[altra83]

Parfait !

Merci pierrejean et Joël pour votre aide !
Je m'en vais actualiser mon doc et décortiquer vos codes