Comparer 2 colonnes dans deux fichiers avec macro

BigA · 17 Juin 2019

Bonsoir à tous,

Je suis débutant en VBA et j'ai besoin de votre aide pour un problème que je rencontre depuis quelques jours.

J'ai deux fichiers, Fichier1 et Fichier2, je voudrai comparer la colonne C du Fichier1 avec la colonne C du Fichier2.
Si une correspondance est trouvée alors la ligne du Fichier1 doit être remplacée par la ligne contenant la correspondance du Fichier2.

Précision: La colonne C du Fichier1 va contenir 1500 lignes dans quelques jours et la fonction match doit être exécutée en boucle de C2 à la dernière ligne.

Est-ce que quelqu'un peut m'aider pour concocter ce code ?

Merci d'avance
Bien cordialement,
BigA

frangy · 17 Juin 2019

Bonjour,

La macro ci-dessous doit être lancée avec les 2 fichiers ouverts.
(adapter au besoin les noms de classeurs et de feuilles).

VB:

Sub Comparer()
Dim WbS As Workbook, WbC As Workbook
Dim WsS As Worksheet, WsC As Worksheet
Dim PlageC As Range, PlageS As Range, Cel As Range, C As Range
    Set WbC = Workbooks("Fichier1")
    Set WbS = Workbooks("Fichier2")
    Set WsC = WbC.Worksheets("Check PC MEP-APA")
    Set WsS = WbS.Worksheets("Sheet1")
    Set PlageC = WsC.Range("C2:C" & WsC.Range("C" & Rows.Count).End(xlUp).Row)
    Set PlageS = WsS.Range("C2:C" & WsS.Range("C" & Rows.Count).End(xlUp).Row)
    Application.ScreenUpdating = False
    For Each Cel In PlageC
        Set C = PlageS.Find(Cel, , xlValues, xlWhole)
        If Not C Is Nothing Then
            C.EntireRow.Copy Cel.EntireRow
            Cel.EntireRow.Font.ColorIndex = 3
        End If
    Next Cel
    Application.ScreenUpdating = True
End Sub

Cordialement.

BigA · 17 Juin 2019

frangy à dit:

Bonjour,

La macro ci-dessous doit être lancée avec les 2 fichiers ouverts.
(adapter au besoin les noms de classeurs et de feuilles).

VB:

Sub Comparer()
Dim WbS As Workbook, WbC As Workbook
Dim WsS As Worksheet, WsC As Worksheet
Dim PlageC As Range, PlageS As Range, Cel As Range, C As Range
    Set WbC = Workbooks("Fichier1")
    Set WbS = Workbooks("Fichier2")
    Set WsC = WbC.Worksheets("Check PC MEP-APA")
    Set WsS = WbS.Worksheets("Sheet1")
    Set PlageC = WsC.Range("C2:C" & WsC.Range("C" & Rows.Count).End(xlUp).Row)
    Set PlageS = WsS.Range("C2:C" & WsS.Range("C" & Rows.Count).End(xlUp).Row)
    Application.ScreenUpdating = False
    For Each Cel In PlageC
        Set C = PlageS.Find(Cel, , xlValues, xlWhole)
        If Not C Is Nothing Then
            C.EntireRow.Copy Cel.EntireRow
            Cel.EntireRow.Font.ColorIndex = 3
        End If
    Next Cel
    Application.ScreenUpdating = True
End Sub

Cordialement.

Bonjour Frangy,

Merci pour ton aide, c'est exactement ce qu'il me fallait.

Bien cordialement,
BigA

Comparer 2 colonnes dans deux fichiers avec macro

BigA

XLDnaute Nouveau

frangy

XLDnaute Occasionnel

BigA

XLDnaute Nouveau

Discussions similaires