Comparaison de 2 fichiers

Option Explicit

'-- /!\ NE PAS OUBLIER DE COCHER LA REFERENCE Microsoft ActiveX Data Object xx Library

Public Sub CompareChampMatricule()
Dim Cn As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim Cd As ADODB.Command
Dim fichier As String
Dim feuille As String
Dim wk As Workbook
Dim ws As Worksheet
Dim ligne As Long
Dim newLigne As Long

    '--- Initialisation ---
    Set Cn = New ADODB.Connection
    Set wk = ThisWorkbook
    Set ws = wk.Worksheets("Feuil1")  'A adapter ...
    fichier = "D:\CCM\monFichier2.xlsx"  'A adapter ...
    feuille = "Feuil1"
    ligne = 2
    '------------------
    
    '--- Connexion au fichier source ---
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
    '-----------------
    
    '--- Traitement -----
    While ws.Range("E" & ligne).Value <> ""
        Set Cd = New ADODB.Command
        Cd.ActiveConnection = Cn
        Set Rst = New ADODB.Recordset
        Cd.CommandText = "SELECT Matricule FROM [" & feuille & "$] WHERE Matricule = '" & ws.Range("E" & ligne).Value & "'"
        Rst.Open Cd, , adOpenKeyset, adLockOptimistic
        Rst.MoveFirst
        If Rst.RecordCount > 0 Then
            Rst.MoveLast
            newLigne = ws.Range("A" & Rows.Count).End(xlUp).Row
            ws.Range("A" & newLigne + 1).CopyFromRecordset Rst
            Set Rst = Nothing
            Set Cd = Nothing
            Query = ""
        End If
        ligne = ligne + 1
    Wend
    '-----------
    
    '--- Libération des objets et de la mémoire
    Set wk = Nothing
    Set ws = Nothing
    Cn.Close
    Set Cn = Nothing
    '-------------------------
    
End Sub

Set ws = wk.Worksheets("Feuil1")  'A adapter ...
fichier = "D:\CCM\monFichier2.xlsx"  'A adapter ...

    Set ws = wk.Worksheets("Suivi")  'A adapter ...
    fichier = "Liste mensuelle des effectifs en 10_13.xlsx"  'A adapter ...
    feuille = "Base mensuelle"

newLigne = ws.Range("A" & Rows.Count).End(xlUp).Row
            ws.Range("A" & newLigne + 1).CopyFromRecordset Rst

fichier = "C:\Users\mmeguellati\Downloads\VBA-natacha\Liste mensuelle des effectifs en 10_13.xlsx"  'A adapter ...

fichier = Application.GetOpenFilename("Fichiers Excels, *.xls*")

  Rst.Open Cd,  ,adOpenKeyset, adLockOptimistic

Option Explicit

Sub ImporterColonnes()
Dim Fichier, WbkCopy As Workbook, WbkColle As Workbook
Dim Colonnes(), col As Integer, Resultat As Variant
Dim NWbkColle As Integer, MWbkCopy As Integer, DWbkColle As Integer



  'On attribue à la variable WbkColle le fichier actuel (celui qui contient la macro)
  Set WbkColle = ThisWorkbook
  'A adapter : Nom des entêtes de colonnes à importer
  Colonnes = Array("Matricule")
  
  'Sélection du fichier
  Fichier = Application.GetOpenFilename("Fichiers Excels, *.xls*")
  'En cas de clic sur "ANNULER"
  If Fichier <> False Then
    'On ouvre le fichier en question
    Set WbkCopy = Workbooks.Open(Fichier)
    
    With WbkCopy.Sheets("Base mensuelle") '==> ADAPTER NOM de la feuille
      'Boucle sur toutes les entêtes des colonnes
      For col = 2 To .Cells(2, .Cells.Columns.Count).End(xlToLeft).Column
        'teste si l'entête correspond à un des noms des colonnes à copier
        Resultat = Application.Match(.Cells(2, col), Colonnes, 0)
        'Si l'entête est trouvée (colonne à copier)
        If Not IsError(Resultat) Then
          'Copié - Collé ==> ADAPTER NOM de la feuille ou coller ("TRUC" à remplacer)
          '.Columns(Col).Copy WbkColle.Sheets("COLLER").Cells(1, Cells.Columns.Count).End(xlToLeft).Offset(0, 1)
          'impression pop-up les colonnes Matricule sont bien là
        
        End If ' si l'entête existe bien
      Next col
            
    'rechercher avec mise-à-jour correspendance valeur
        
    For NWbkColle = 4 To WbkColle.Sheets("Suivi").Range("E65536").End(xlUp).Row
    For MWbkCopy = 4 To WbkCopy.Sheets("Base mensuelle").Range("I65536").End(xlUp).Row
    For DWbkColle = 4 To WbkColle.Sheets("Suivi").Range("M65536").End(xlUp).Row
    
    If InStr(WbkCopy.Sheets("Base mensuelle").Range("I" & MWbkCopy), WbkColle.Sheets("Suivi").Range("E" & NWbkColle)) <> 0 Then
        'Copié - collé
         WbkCopy.Sheets("Base mensuelle").Range("I" & MWbkCopy).Copy WbkColle.Sheets("Suivi").Range("M" & DWbkColle)
    
    End If
   Next NWbkColle
   Next MWbkCopy
   Next DWbkColle
    
    End With
       
    WbkCopy.Close
  End If
Set WbkCopy = Nothing
Set WbkColle = Nothing
End Sub