Discussion :

[BRUNO71]

Bonjour,
J'ai copié un bout de code sur le forum et je tente de l'appliquer à ma cause...mais en vain.
Voici ce code :

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
 
Dim E_F1 As Range
Dim E_F2 As Range
 
With Worksheets("Feuil1")
    Set E_F1 = .Range("E" & .Rows.Count).End(xlUp)
 
    Set E_F2 = Worksheets("Feuil2").Range("E" & .Rows.Count).End(xlUp)
 
    For i = 0 To .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row - 1
        For j = 0 To Worksheets("Feuil2").Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row - 1
            If E_F1.Offset(i, 0) = E_F2.Offset(j, 0) Then
                For k = 1 To 4
                    E_F1.Offset(i, k) = E_F2.Offset(j, k)
                Next k
            End If
        Next j
    Next i
End With

L'objective c'est de comparer la colonne E de la Feuil2 à la colonne E de la Feuil1.
Si il y a une correspondance, on copie et colle les 4 colonnes (A, B, C et D) de la Feuil1 vers la Feuil2.
Et si pas de correspondance on ne fait rien.
Que dois-je modifier pour l'adapter ?
Merci

[Invité]

Bonjour,

Une solution possible :

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
Option Explicit
 
Sub ComparerLesDeuxColonnesE()
 
Dim E_F1 As Range
Dim CelluleF1 As Range
Dim DerniereLigneF1 As Long
 
Dim E_F2 As Range
Dim CelluleF2 As Range
Dim DerniereLigneF2 As Long
 
    With Worksheets("Feuil1")
         DerniereLigneF1 = .Cells(.Rows.Count, 5).End(xlUp).Row
         Set E_F1 = .Range(.Cells(2, 5), .Cells(DerniereLigneF1, 5))
         'MsgBox E_F1.Address
    End With
 
    With Worksheets("Feuil2")
         DerniereLigneF2 = .Cells(.Rows.Count, 5).End(xlUp).Row
         Set E_F2 = .Range(.Cells(2, 5), .Cells(DerniereLigneF2, 5))
         'MsgBox E_F2.Address
    End With
 
    For Each CelluleF2 In E_F2
        For Each CelluleF1 In E_F1
            If CelluleF2 = CelluleF1 Then
               Range(CelluleF2.Offset(0, 1), CelluleF2.Offset(0, 4)).Value = Range(CelluleF1.Offset(0, 1), CelluleF1.Offset(0, 4)).Value
               Exit For
            End If
        Next CelluleF1
    Next CelluleF2
 
    Set E_F2 = Nothing
    Set E_F1 = Nothing
 
End Sub

Si il y a une correspondance, on copie et colle les 4 colonnes (A, B, C et D) de la Feuil1 vers la Feuil2.

Nb : Votre code semble faire l'inverse.

Cordialement.

[BRUNO71]

Merci Eric,

Ca me semble très bien....mais comment ça doit fonctionner....
Voici le fichier avec la macro....mais je n'y arrive pas...

Merci

[Invité]

Il faut modifier l'aire copiée

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
Option Explicit
 
Sub Bouton1_Clic()
 
Dim E_F1 As Range
Dim CelluleF1 As Range
Dim DerniereLigneF1 As Long
 
Dim E_F2 As Range
Dim CelluleF2 As Range
Dim DerniereLigneF2 As Long
 
    With Worksheets("Feuil1")
         DerniereLigneF1 = .Cells(.Rows.Count, 5).End(xlUp).Row
         Set E_F1 = .Range(.Cells(2, 5), .Cells(DerniereLigneF1, 5))
        ' MsgBox E_F1.Address
    End With
 
    With Worksheets("Feuil2")
         DerniereLigneF2 = .Cells(.Rows.Count, 5).End(xlUp).Row
         Set E_F2 = .Range(.Cells(2, 5), .Cells(DerniereLigneF2, 5))
        ' MsgBox E_F2.Address
    End With
 
    For Each CelluleF2 In E_F2
        For Each CelluleF1 In E_F1
            If CelluleF2 = CelluleF1 Then
               Range(CelluleF2.Offset(0, -4), CelluleF2.Offset(0, -1)).Value = Range(CelluleF1.Offset(0, -4), CelluleF1.Offset(0, -1)).Value
               Exit For
            End If
        Next CelluleF1
    Next CelluleF2
 
    Set E_F2 = Nothing
    Set E_F1 = Nothing
 
 
End Sub

Cordialement.

[BRUNO71]

Merci ERIC,
, c'est excellent...rapide efficace....le top.
Je viens de l'adapter à ma situation...

Cordialement,