Discussion :

[2lester]

Bonjour,

A partir de 2 feuilles A et B d'un même classeur sur lesquelles j'ai un champ en commun, je souhaite :

1- pour chaque ligne de la feuille A on parcourt toutes les lignes de la feuille B
2- si une correspondance est trouvée sur le champ commun, alors on supprime la ligne concernée dans la feuille B ainsi que dans la feuille A
3- on recommence la boucle en 1-

J'ai trouvé le code suivant écrit par Ctplm en 2009 sur un autre forum (et à qui j'ai bien sûr posé la question mais pas de réponse), qui correspond quasiment à ce que je cherche, sauf qu'il ne supprime pas la ligne dans la feuille A également :

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
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 
Dim NbLigneSheet1, NbLigneSheet2, LigneDbtData1, LigneDbtData2, a, b As Integer 
Dim F1, F2 As Object 
 
'Procédure principale 
Sub SuppressionLignes() 
 
'On appelle les procédures qui initialisent les variables 
Call InitVar 
Call CalculNbLignes 
 
'On parcourt la première feuille 
For a = LigneDbtData1 To NbLigneSheet1 
 
'Pour chaque ligne de la première feuille, on parcourt complètement la deuxième feuille
 For b = LigneDbtData2 To NbLigneSheet2 
 
'On compare les contenus des deux feuilles 
VarNom = F1.Range("B" & a)
 
If VarNom = F2.Range("D" & b) Then 
 
'En cas de correspondance on supprime la ligne correspondante dans la deuxième feuille
 F2.Range("A" & b).Select 
Selection.EntireRow.Delete 
'Ne pas oublier de décrémenter b sinon on zappe une ligne 
b = b - 1 
 
End If 
 
Next b 
Next a 
 
End Sub

J'ai essayé de l'adapter pour répondre à mon besoin mais ça ne fonctionne pas...

Y a-t-il quelqu'un pour m'aider ?
Merci par avance

[mercatog]

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
17
18
19
20
21
22
23
24
25
Sub SupprDoub()
Dim LastLigA As Long, LastLigB As Long, i As Long
Dim Sh As Worksheet
Dim c As Range
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    LastLigA = .Cells(.Rows.Count, "A").End(xlUp).Row
    If LastLigA > 1 Then
        Set Sh = Worksheets("Feuil2")
        LastLigB = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row
        If LastLigB > 1 Then
            For i = LastLigA To 2 Step -1
                Set c = Sh.Range("A:A").Find(.Range("A" & i), LookIn:=xlValues, lookat:=xlWhole)
                If Not c Is Nothing Then
                    .Rows(i).Delete
                    c.EntireRow.Delete
                    Set c = Nothing
                End If
            Next i
        End If
        Set Sh = Nothing
    End If
End With
End Sub

[2lester]

Impeccable !!
Merci beaucoup et bonne journée