Copier/Coller de lignes si un id est le même dans 2 feuilles

**stan63** · 16/01/2014, 15h39

Bonjour,

Comme la plupart des personnes qui postent un sujet ici, j'ai un petit problème.
J'aimerai créer une macro (fonction) qui en fonction d'un identifiant dans une colonne dans deux feuilles différentes copie dans une troisième feuille les lignes de la première feuille si l'identifiant est dans la liste de la deuxième feuille. (Je vais expliquer un peu plus le principe... )

Dans la feuille 1, j'ai en colonne : Date I Info 1 I ID I Info 2 I Info 3
Dans la feuille 2, j'ai en colonne : Info 4 I ID

Le resultat attendu en feuille 3 (appelée Merge) : Date I Info 1 I ID I Info 2 I Info 3 I Info 4
Sachant que je ne veux que les lignes où l'ID a été trouvé dans la feuille 2.

Donc en gros, j'ai plus de lignes dans la feuille 1, et j'aimerais en fonction des ID de la feuille 2 copier les lignes de la feuille 1 dans la feuille 3 en ajoutant les données (Info 4) dans la dernière colonne.

Petite précision, dans la feuille 1 (et 2) les ID sont répétées plusieurs fois avec des Dates, Infos 1, 2 et 3 différents. Mais les Infos 4 sont toujours liées à un ID.

Ce que je ne veux pas :
C'est que si je trouve plusieurs fois l'ID dans la feuille 2 ça me copie plusieurs fois une ligne de la feuille 1.

Je ne sais pas si tout est clair... :s Mais je veux bien donner un peu plus d'explications s'il faut !!

En tout cas, un très grand merci pour votre aide et pour le temps que vous prennez au moins pour me lire.

Stan63

**XLRATOR** · 16/01/2014, 17h09

Bonsoir,
Je vous poste une idée parmis des milliers d'autres sur ce que vous avez l'intention de faire.

Exemple.xls

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
Private Sub CommandButton1_Click()
Dim rng As Range, Rng1 As Range
Application.ScreenUpdating = False
For Each rng In Sheets(2).Range("A2:A5000").SpecialCells(xlCellTypeConstants)
        For Each Rng1 In Sheets(1).Range("B2:B5000").SpecialCells(xlCellTypeConstants)
        If Rng1.Value = rng Then
        Sheets(3).Range("B65536").End(xlUp).Offset(1, 0).Value = Rng1.Value
        Sheets(3).Range("B65536").End(xlUp).Offset(0, 1).Value = Rng1.Offset(0, 1).Value
        Sheets(3).Range("B65536").End(xlUp).Offset(0, 2).Value = Rng1.Offset(0, 2).Value
        Sheets(3).Range("B65536").End(xlUp).Offset(0, 3).Value = Rng1.Offset(0, 3).Value
        Sheets(3).Range("B65536").End(xlUp).Offset(0, 4).Value = rng.Offset(0, 1).Value
        Sheets(3).Range("B65536").End(xlUp).Offset(0, -1).Value = Rng1.Offset(0, -1).Value
        End If
        Next
        Next
        MsgBox "C'est fait!"
        Sheets(3).Activate
End Sub

Cordialement.
Karim

**stan63** · 16/01/2014, 19h54

Bonsoir XLRATOR,

C'est très bien l'exemple que tu as fait !! C'est quasiment ce que je désire.

Je dis quasiment car si dans la sheet2, tu rentres l'ID 10002, en résultat, tu vas avoir une ligne en plus avec l'ID 10002 dans la sheet 3 mais justement, je ne veux pas de dupplication là dessus...

Date ID Info 1 Info 2 Info 3 Info 4
07/06/2013 10002 Mariane Bordeaux 87 Sport
27/06/2013 10005 Bernard Guigamp 27 Litterature
14/06/2013 10008 Samir Paris 56 Aviation
17/07/2013 10008 Murielle Quimpere 34 Aviation
~~07/06/2013 10002 Mariane Bordeaux 87 Journalisme~~

Je ne sais pas si je suis clair... Et si tu as compris ?

Un grand merci en tout cas !!

Stan63

**XLRATOR** · 16/01/2014, 20h23

Bonsoir Stan63,
Dans ce cas il va falloir définir un critére qui spécifie la ligne à maintenir et celle que vous devez vous en débarasser.
si vous avez seulement l'intention de garder la toute premiére ligne sur laquelle Excel Tombe ce serait:

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
Private Sub CommandButton1_Click()
Dim rng As Range, Rng1 As Range, Rng2 As Range
Application.ScreenUpdating = False
For Each rng In Sheets(2).Range("A2:A5000").SpecialCells(xlCellTypeConstants)
        For Each Rng1 In Sheets(1).Range("B2:B5000").SpecialCells(xlCellTypeConstants)
                    For Each Rng2 In Sheets(3).Range("B2:B5000").Cells
        If Rng1.Value = rng And Rng1.Value <> Rng2.Value Then
        Sheets(3).Range("B65536").End(xlUp).Offset(1, 0).Value = Rng1.Value
        Sheets(3).Range("B65536").End(xlUp).Offset(0, 1).Value = Rng1.Offset(0, 1).Value
        Sheets(3).Range("B65536").End(xlUp).Offset(0, 2).Value = Rng1.Offset(0, 2).Value
        Sheets(3).Range("B65536").End(xlUp).Offset(0, 3).Value = Rng1.Offset(0, 3).Value
        Sheets(3).Range("B65536").End(xlUp).Offset(0, 4).Value = rng.Offset(0, 1).Value
        Sheets(3).Range("B65536").End(xlUp).Offset(0, -1).Value = Rng1.Offset(0, -1).Value
        End If
        Exit For
                    Next
        Next
Next
        MsgBox "C'est fait!"
        Sheets(3).Activate
End Sub

Il vous suffit de remplacer le code précédent par celui-ci.
J'espére vous avoir bien compris.

Cordialement
Karim.

**stan63** · 16/01/2014, 20h31

Je vais essayer d'être plus clair.

Feuille 1
Date ID Info1 Info2 Info3
21/05/2013 10001 Armand Marseille 45
07/06/2013 10002 Mariane Bordeaux 87
14/06/2013 10008 Samir Paris 56
21/06/2013 10004 Chantale Lille 81
27/06/2013 10005 Bernard Guigamp 27
06/07/2013 10006 Paul Lyon 67
10/07/2013 10007 Sebastien Toulouse 92
17/07/2013 10008 Murielle Quimpere 34
23/07/2013 10009 Vincent Strasbourg 67
02/08/2013 10010 Laetitia Valencienne 42

Feuille 2
ID Info 4
10000 Sport
10005 Litterature
10002 Aviation
10002 Journalisme
10008 Lecture

Résultat feuille 3 :
Date ID Info 1 Info 2 Info 3 Info 4
27/06/2013 10005 Bernard Guigamp 27 Litterature
07/06/2013 10002 Mariane Bordeaux 87 Aviation
~~07/06/2013 10002 Mariane Bordeaux 87 Journalisme~~
14/06/2013 10008 Samir Paris 56 Lecture
17/07/2013 10008 Murielle Quimpere 34 Lecture

Cette ligne est en trop :
07/06/2013 10002 Mariane Bordeaux 87 Journalisme

Par contre, il est normal de trouver :
14/06/2013 10008 Samir Paris 56 Lecture
17/07/2013 10008 Murielle Quimpere 34 Lecture
=> Parce que 10008 apparaît deux fois dans la feuille 1

En gros je ne prends pas les "doublons" ID de la feuille 2.

Suis-je plus clair ?

Stan63

**XLRATOR** · 16/01/2014, 21h13

Essayez alors avec ça:

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
Private Sub CommandButton1_Click()
Dim rng As Range, Rng1 As Range, Rng2 As Range, Rng4 As Range
Application.ScreenUpdating = False
For Each Rng1 In Sheets(1).Range("B2:B5000").SpecialCells(xlCellTypeConstants)
            For Each rng In Sheets(2).Range("A2:A5000").SpecialCells(xlCellTypeConstants)
                For Each Rng2 In Sheets(3).Range("B1:B5000").SpecialCells(xlCellTypeConstants)
                    If Rng1.Value <> Rng2.Value And Rng1.Value = rng.Value Then
                    Sheets(3).Range("B65536").End(xlUp).Offset(1, 0).Value = Rng1.Value
                    Sheets(3).Range("B65536").End(xlUp).Offset(0, 1).Value = Rng1.Offset(0, 1).Value
                    Sheets(3).Range("B65536").End(xlUp).Offset(0, 2).Value = Rng1.Offset(0, 2).Value
                    Sheets(3).Range("B65536").End(xlUp).Offset(0, 3).Value = Rng1.Offset(0, 3).Value
                    Sheets(3).Range("B65536").End(xlUp).Offset(0, 4).Value = rng.Offset(0, 1).Value
                    Sheets(3).Range("B65536").End(xlUp).Offset(0, -1).Value = Rng1.Offset(0, -1).Value
                    End If
                    Exit For
                    Next
        Next
Next
 
                    For Each Rng4 In Sheets(3).Range("B2:B5000").SpecialCells(xlCellTypeConstants)
                    If Rng4.Offset(-1, 0).Value = Rng4.Value Then
                    Rng4.EntireRow.Delete
                    End If
                    Next
 
        MsgBox "C'est fait!"
        Sheets(3).Activate
End Sub

**stan63** · 17/01/2014, 10h15

Merci beaucoup XLRATOR !!!

Cela marche très bien !!!!!!

Copier/Coller de lignes si un id est le même dans 2 feuilles [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager