Compare colonne de deux classeurs.xls et rempli une cellule ..

Bonjour,

Les deux classeurs sont ils ouverts au moment du lancement de la macro?
La macro devra être dans le classeur RECEPTION_DISPO.xls?

BONJOUR,pijaku

La macro dans le classeur RECEPTION_DISPO.xls cela est parfait
et le classeur DISPO.xls est fermé.

MERCI

re BONJOUR,pijaku

Je crois que 5000 lignes seras largement suffisant

MERCI

micheleliane

Bon.
Voici le code à insérer dans un module du classeur RECEPTION_DISPO.xls

Sub Compare_Col_A_DISPO()
Dim monWbk As Workbook
Dim Chemin As String, Fichier As String
Dim dl As Long, Lig As Long, Num As Long
Dim Tb_Dispo(), Tb_Recep_Dispo(), Tb_Col_P()

Set monWbk = ThisWorkbook
Chemin = monWbk.Path & ""
Fichier = "DISPO.xls"

'***** TRAITEMENT SUR CLASSEUR DISPO.xls ****
Workbooks.Open Chemin & Fichier 'ouverture
With ActiveWorkbook
    With .Worksheets("Feuil1")
        dl = .Range("A" & Rows.Count).End(xlUp).Row
        Tb_Dispo = .Range("A3:A" & dl).Value 'stockage des données
    End With
    .Close False 'fermeture
End With


'***** TRAITEMENT SUR CLASSEUR RECEPTION_DISPO.xls ****
With monWbk.Sheets("NOUVADH")
    dl = .Range("A" & Rows.Count).End(xlUp).Row
    Tb_Recep_Dispo = .Range("A3:A" & dl).Value 'stockage des données
    ReDim Preserve Tb_Col_P(UBound(Tb_Recep_Dispo))
    'boucle sur les données de RECEPTION_DISPO
    For Lig = LBound(Tb_Recep_Dispo) To UBound(Tb_Recep_Dispo)
        Num = 0
        On Error Resume Next
        'Vérification de la présence dans DISPO.xls
        Num = Application.Match(Tb_Recep_Dispo(Lig, 1), Application.Index(Tb_Dispo, , 1), 0)
        On Error GoTo 0
        If Num = 0 Then
            'pas de correspondance
            Tb_Col_P(Lig) = "Pas de correspondance dans DISPO.xls"
        Else
            'correspondance
            Tb_Col_P(Lig) = "P"
        End If
    Next Lig
    
    '***** RESTITUTION DES "P" et "Pas de correspondance dans DISPO.xls" *****
    .Range("P2").Resize(UBound(Tb_Col_P) + 1) = Application.Transpose(Tb_Col_P)
    
End With
End Sub

Cordialement,
Franck

re BONJOUR,pijaku
J'ai erreur le nom du classeur n'ai pas bonne et je ne comprend pas comment
changer l'adresse ( C:\Users\michel\Desktop\A_COMMENTcaMARCHEDISPO.xls)
dans la ligne (12) en JAUNE ci dessous la bonne adresse
( C:\Users\michel\Desktop\A_COMMENTcaMARCHE\DISPO.xls)
Je m'excuse mais ne trouve pas
Pouvez vous expliquer ou se trouve l'adresse
MERCI
micheleliane

re re re BONJOUR,pijaku
Pour le chemin cela fonctionne
Excuse moi je me suis encore mal exprimé pour (pas de correspondance )je voudrais
que le contenue de la cellule dans DISPO et qui ne trouve pas sa correspondance
dans RECEPTION_DISPO
Explication dans (NOUVADH de RECEPTION_DISPO)normalement tous les adhérents son inscrit
Dans (DISPO) seulement ceux qui participe mais ils peut avoir des
nouveaux qui ne sont pas encore dans l'autre classeur
En exemple le 3333 de( DISPO) n'existe pas dans(RECEPTION_DISPO) il faut le signaler
En espérant votre comprehension
MERCI
micheleliane

re BONJOUR,pijaku
Vous avez vue comment je suis nul, je voudrais qu'il faut valider qu'il n'y a pas
de correspondance pour l'ajouter dans (RECEPTION_DISPO)
Excusez-moi de ne pas savoir mieux expliquer
MERCI
micheleliane

re BONJOUR pijaku

La référence que vous indiquez est parfaite oui il faut l'ajouter

MERCI à l'avance
micheleliane

RE-
Et voici :

Sub Compare_Col_A_DISPO()
Dim monWbk As Workbook
Dim Chemin As String, Fichier As String
Dim dl As Long, Lig As Long, Num As Long
Dim Tb_Dispo(), Tb_Recep_Dispo(), Tb_Col_P()

Set monWbk = ThisWorkbook
Chemin = monWbk.Path & ""
Fichier = "DISPO.xls"

'***** TRAITEMENT SUR CLASSEUR DISPO.xls ****
Workbooks.Open Chemin & Fichier 'ouverture
With ActiveWorkbook
    With .Worksheets("Feuil1")
        dl = .Range("A" & Rows.Count).End(xlUp).Row
        Tb_Dispo = .Range("A3:A" & dl).Value 'stockage des données
    End With
    .Close False 'fermeture
End With

'***** TRAITEMENT SUR CLASSEUR RECEPTION_DISPO.xls ****
With monWbk.Sheets("NOUVADH")
    dl = .Range("A" & Rows.Count).End(xlUp).Row
    Tb_Recep_Dispo = .Range("A3:A" & dl).Value 'stockage des données
    ReDim Preserve Tb_Col_P(UBound(Tb_Recep_Dispo))
    'boucle sur les données de RECEPTION_DISPO
    For Lig = LBound(Tb_Recep_Dispo) To UBound(Tb_Recep_Dispo)
        Num = 0
        On Error Resume Next
        'Vérification de la présence dans DISPO.xls
        Num = Application.Match(Tb_Recep_Dispo(Lig, 1), Application.Index(Tb_Dispo, , 1), 0)
        On Error GoTo 0
        If Num = 0 Then
            'pas de correspondance
            Tb_Col_P(Lig) = ""
        Else
            'correspondance
            Tb_Col_P(Lig) = "P"
        End If
    Next Lig
    
    '***** RESTITUTION DES "P" et "Pas de correspondance dans DISPO.xls" *****
    .Range("P2").Resize(UBound(Tb_Col_P) + 1) = Application.Transpose(Tb_Col_P)

    '***** TRAITEMENT des références disponibles dans DISPO mais pas dans RECEPTION
    For Lig = LBound(Tb_Dispo) To UBound(Tb_Dispo)
        Num = 0
        On Error Resume Next
        'Vérification de la présence dans RECEPTION_DISPO.xls
        Num = Application.Match(Tb_Dispo(Lig, 1), Application.Index(Tb_Recep_Dispo, , 1), 0)
        On Error GoTo 0
        If Num = 0 Then
            'pas de correspondance
            If MsgBox("La référence : " & Tb_Dispo(Lig, 1) & ", présente dans DISPO.xls, n'est pas enregistrée dans RECEPTION_DISPO.xls." & Chr(10) & "Voulez-vous l'ajouter?", vbYesNo + vbQuestion) = vbYes Then
                .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Tb_Dispo(Lig, 1)
            End If
        End If
    Next Lig
End With
End Sub

BONNE SOIREE,pijaku

MERCI cela fonctionne très bien
MERCI de votre patience
MERCI du temps que vous m'avez accordé

micheleliane