Comparer les cellules des deux premières colonnes de deux feuilles différentes, copier et transposer la ligne

**Vanil** · 18/10/2015, 13h30

Bonjour,
Je suis nouvelle sur le forum et débutante en VBA. Je travaille sur un projet qui me pose des soucis en ce moment et j'aurai besoin d'aide.
En fait, j'ai deux feuilles excel dans le même classeur. Les différentes actions que je veux mener sont les suivantes.
- Comparer chaque cellule de la colonneA de la feuille1 à celles de la feuille2
- Si la valeur d'une cellule de la colonneA de la feuille 1 correspond à l'une des cellules de la colonneA de la seconde feuille alors reprendre l'opération précédente mais cette fois avec les colonnes B des deux feuilles
- Si correspondance pour les colonnesB alors copier la ligne concernée (de C à AA) dans la feuille2 et la coller en la transposant dans la feuille1(à partir de la ligne où il y a correspondance)
- reprendre la procédure jusqu'à la fin de la feuille 1

J'ai éssayer d'écrire un code mais il ne marche pas. Je l'ai tourner dans tous les sens mais en vain, aidez moi svp.

Voici le code que j'ai écrit:

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 Proj()
Dim i As Long, j As Long
Dim k As Long, l As Long
Dim pag As Range
Set F1 = ("Feuil1")
Set F2 = ("Feuil2")
With ActiveSheet
Sheets("Feuil1").Select
For i = 2 To F1.Cells(.Rows.Count, 1).End(xlUp).Row
Sheets("Feuil2").Select
For j = 2 To F2.Cells(.Rows.Count, 1).End(xlUp).Row
If F1.Cells(i, 1).Value = F2.Cells(j, 1).Value Then
        For k = i To F1.Cells(.Rows.Count, 2).End(xlUp).Row
        For l = 2 To F2.Cells(.Rows.Count, 2).End(xlUp).Row
            If F2.Cells(k, 2).Value = F1.Cells(l, 2).Value Then
            Set pag = Feuil2.Range("C2:H2" & Feuil2.Range("A65535").End(xlUp).Row)
            pag.Cells(k, 2).Rows.Copy
            F1.Cells(i, 4).PasteSpecial Paste:=xlPasteAll, Transpose:=True
            End If
        Next
        Next
End If
Next
Next
End Sub

**Theze** · 18/10/2015, 18h31

Bonjour,

Une piste. Attention, en transposant, si une cellule au dessous de celle en cours a une valeur identique en feuille 2 et qu'il y a moins de 25 lignes, des valeurs seront perdues :

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
35
36
37
38
39
40
41
42
43
44
45
46
47
 
Sub Test()
 
    Dim Fe1 As Worksheet
    Dim Fe2 As Worksheet
    Dim Plage_Fe1 As Range
    Dim Plage_Fe2 As Range
    Dim Cel_Fe1 As Range
    Dim Cel_Fe2 As Range
 
    Set Fe1 = Worksheets("Feuil1")
    Set Fe2 = Worksheets("Feuil2")
 
    'défini la plage 1 sur la colonne A de la feuille "Feuil1"
    With Fe1: Set Plage_Fe1 = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
 
    'défini la plage 2 sur la colonne A de la feuille "Feuil2"
    With Fe2: Set Plage_Fe2 = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
 
    'parcours la plage de la feuille "Feuil1"
    '-->- Comparer chaque cellule de la colonneA de la feuille1 à celles de la feuille2<--
    For Each Cel_Fe1 In Plage_Fe1
 
        'effectue la recherche de la valeur dans la colonne A de la feuille "Feuil2"
        '-->- Si la valeur d'une cellule de la colonneA de la feuille 1 correspond à l'une des
        'cellules de la colonneA de la seconde feuille alors reprendre l'opération précédente mais cette fois avec les colonnes B des deux feuilles<--
        Set Cel_Fe2 = Plage_Fe2.Find(Cel_Fe1, , xlValues, xlWhole)
 
        'si trouvée...
        If Not Cel_Fe2 Is Nothing Then
 
            'si les cellules de la colonne B de chaque feuilles sont aussi identiques
            'copie sur la feuille "Feuil1" en transposant les valeurs de la feuille "Feuil2" de C à AA
            '-->- Si correspondance pour les colonnesB alors copier la ligne concernée (de C à AA) dans
            'la feuille2 et la coller en la transposant dans la feuille1(à partir de la ligne où il y a correspondance)<--
            If Cel_Fe2.Offset(, 1).Value = Cel_Fe1.Offset(, 1).Value Then
 
                Fe1.Range(Cel_Fe1.Offset(, 2), Cel_Fe1.Offset(24, 2)).Value = WorksheetFunction.Transpose(Fe2.Range(Cel_Fe2.Offset(, 2), Cel_Fe2.Offset(, 26)).Value)
 
            End If
 
        End If
 
    '-->- reprendre la procédure jusqu'à la fin de la feuille 1<--
    Next Cel_Fe1
 
End Sub

**Vanil** · 18/10/2015, 20h25

Bonjour Theze
Merci de m'avoir repondu.

J'ai lancé le code mais ça ne marche pas.
D'après les résultats que j'ai, il a recopier 25 fois la valeur de la cellule(ligne où il y a la correspondance, C) de la feuille2. Ensuitte c'est un peu compliqué à expliquer donc je vais joindre le fichier pour que vous voyez par vous même.

Ensuite peut être que c'est moi qui ne comprend pas le code mais je n'ai pas l'impression qu'il effectue la recherche sur les colonnes B. Je voudrais en fait que s'il trouve une correspondance entre une cellule de la col1 de Feuil1, il recherche la valeur de la cellule sur la même ligne que la précédente (ColB de Feuil1) dans la colB de Feuil2.
Et puis je souhaiterais qu'il colle la ligne concernée dans la colonne D de la feuille 1.
J'espère que vous y avez compris quelque chose.

Merci et j'attends que vous m'aidiez à nouveau.

**Theze** · 19/10/2015, 14h35

Bonjour,

Là, il va falloir éclaircir cetains points !
Tu dis :

Ensuite peut être que c'est moi qui ne comprend pas le code mais je n'ai pas l'impression qu'il effectue la recherche sur les colonnes B. Je voudrais en fait que s'il trouve une correspondance entre une cellule de la col1 de Feuil1, il recherche la valeur de la cellule sur la même ligne que la précédente (ColB de Feuil1) dans la colB de Feuil2.

C'est exactement ce que fait le code ici :

Code :

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

1
2
 
If Cel_Fe2.Offset(, 1).Value = Cel_Fe1.Offset(, 1).Value Then

il compare les valeurs des deux cellules en colonne B sur chaque feuille !
Il peut être changé de cette façon :

Code :

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

1
2
 
If Cel_Fe2.Offset(, 1).Value Like Cel_Fe1.Offset(, 1).Value Then

- Si correspondance pour les colonnesB alors copier la ligne concernée (de C à AA) dans la feuille2 et la coller en la transposant dans la feuille1(à partir de la ligne où il y a correspondance)

Ici, le code transpose les valeurs situées en colonnes C à AA de la feuille "Feuil2" :

Code :

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

1
2
 
WorksheetFunction.Transpose(Fe2.Range(Cel_Fe2.Offset(, 2), Cel_Fe2.Offset(, 26)).Value)

Comme tu n'as rien précisé là dessus, je suis parti sur la colonne C mais je te re poste le code avec les modifs pour avoir les valeurs en colonnes D :

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
35
36
37
38
39
40
41
42
43
44
45
46
47
 
Sub Test()
 
    Dim Fe1 As Worksheet
    Dim Fe2 As Worksheet
    Dim Plage_Fe1 As Range
    Dim Plage_Fe2 As Range
    Dim Cel_Fe1 As Range
    Dim Cel_Fe2 As Range
 
    Set Fe1 = Worksheets("Feuil1")
    Set Fe2 = Worksheets("Feuil2")
 
    'défini la plage 1 sur la colonne A de la feuille "Feuil1"
    With Fe1: Set Plage_Fe1 = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
 
    'défini la plage 2 sur la colonne A de la feuille "Feuil2"
    With Fe2: Set Plage_Fe2 = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
 
    'parcours la plage de la feuille "Feuil1"
    '-->- Comparer chaque cellule de la colonneA de la feuille1 à celles de la feuille2<--
    For Each Cel_Fe1 In Plage_Fe1
 
        'effectue la recherche de la valeur dans la colonne A de la feuille "Feuil2"
        '-->- Si la valeur d'une cellule de la colonneA de la feuille 1 correspond à l'une des
        'cellules de la colonneA de la seconde feuille alors reprendre l'opération précédente mais cette fois avec les colonnes B des deux feuilles<--
        Set Cel_Fe2 = Plage_Fe2.Find(Cel_Fe1, , xlValues, xlWhole)
 
        'si trouvée...
        If Not Cel_Fe2 Is Nothing Then
 
            'si les cellules de la colonne B de chaque feuilles sont aussi identiques
            'copie sur la feuille "Feuil1" en transposant les valeurs de la feuille "Feuil2" de C à AA
            '-->- Si correspondance pour les colonnesB alors copier la ligne concernée (de C à AA) dans
            'la feuille2 et la coller en la transposant dans la feuille1(à partir de la ligne où il y a correspondance)<--
            If Cel_Fe2.Offset(, 1).Value Like Cel_Fe1.Offset(, 1).Value Then
 
                Fe1.Range(Cel_Fe1.Offset(, 3), Cel_Fe1.Offset(24, 3)).Value = WorksheetFunction.Transpose(Fe2.Range(Cel_Fe2.Offset(, 2), Cel_Fe2.Offset(, 26)).Value)
 
            End If
 
        End If
 
    '-->- reprendre la procédure jusqu'à la fin de la feuille 1<--
    Next Cel_Fe1
 
End Sub

**Vanil** · 19/10/2015, 16h16

Bonjour Theze

J'ai relancé le code modifié et les résultats sont toujours pareils.
Je suis désolé de t'importuner avec ça. Je vais essayer de trouver une nouvelle approche.
Merci vraiment d'avoir pris le temps de répondre.

**Theze** · 19/10/2015, 17h12

Poste ton fichier pour voir. Remplace les données confidentielles par des données bidons !

Comparer les cellules des deux premières colonnes de deux feuilles différentes, copier et transposer la ligne [XL-2013]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager