Rechercher si valeur et copier si non présence

Bonjour à tous,

Je galere à trouver une solution à mon problème:

J'ai 2 fichier excel A (A contient plusieurs onglets )et B.

Je souhaiterais rechercher une valeur du fichier A ,onglet 1 dans le fichier B dans la 1ere colonne. Si la valeur est deja présente ecrire la colonne B sur la meme ligne "deja réalisé) et si elle n'est pas présente copier la valeur dans la colonne A à la fin du tableau (donc la premiere cellule vide) et ecrire dans la colonne B sur la meme ligne (créé).

Merci de votre aide,

Bien cordialement,

Bonjour mdlvfb,

à adapter et à tester

Sub Recherche_Copie()
Dim WsS As Worksheet, WsD As Worksheet
Dim A As Range, Cel As Range
Application.ScreenUpdating = False

    Set WsS = Workbooks("A.xlsm").Worksheets("Feuil1") ' à adapter!
    Set WsD = Workbooks("B.xlsx").Worksheets("Feuil1") ' à adapter!

    For Each A In WsS.Range("A2:A" & WsS.Range("A" & Rows.Count).End(xlUp).Row)
        Set Cel = WsD.Columns("A").Find(A, , xlValues, xlWhole)
        If Not Cel Is Nothing Then
            Cel.Offset(0, 1) = "deja réalisé"
        Else
        WsD.Range("A" & WsD.Range("A" & Rows.Count).End(xlUp).Row + 1) = A
        WsD.Range("B" & WsD.Range("A" & Rows.Count).End(xlUp).Row) = "créé"
        End If
    Next A
    Set WsD = Nothing: Set WsS = Nothing
Application.ScreenUpdating = True
End Sub

Sinon

@++

Merci beaucoup

Je vais essayer, cependant si mon fichier A peut changer de nom, il faudrait que je nomme WsS par le classeur actif en sachant que dans ma macro, j'ouvre et je ferme mon fichier B.

J'ai adapté mon code comme cela, mais j'ai une incompatibilité de type sur la ligne: " Set Cel = Columns("A").Find(A, xlValues, xlPart)"

Sub suivi()

Dim WsA As Worksheet, WsS As Worksheet

Dim A As String

Dim Cel As Range

Set WsA = Workbooks("PSI - Spécifications.xlsm").Worksheets("Informations de spécifications")

A = WsA.Range("D19")

Workbooks.Open Filename:= _

"R:\DIR_OPERATIONS\40_USINE_BEAUVAIS\4038_ECHANGE_DEV_PRODUCTION\PSI\Complétude fiche de spécification.xlsx" _

, ReadOnly:=True

Set WsS = Workbooks("Complétude fiche de spécification.xlsx").Worksheets("Suivi")

Set Cel = Columns("A").Find(A, xlValues, xlPart)

If Not Cel Is Nothing Then

Workbooks("Complétude fiche de spécification.xlsx").Worksheets("Suivi").Range("A3") = "deja réalisé"

Else

WsS.Range("A" & WsS.Range("A" & Rows.Count).End(xlUp).Row + 1) = A

End If

Workbooks("Complétude fiche de spécification.xlsx").Save

Workbooks("Complétude fiche de spécification.xlsx").Close

End Sub

Je n'arrive pas à trouver mon erreur... merci

Re,

je comprend plus rien

essaie comme ca

Sub suivi()

Dim WsA As Worksheet, WsS As Worksheet
Dim A As String
Dim Cel As Range

Set WsA = Workbooks("PSI - Spécifications.xlsm").Worksheets("Informations de spécifications")
A = WsA.Range("D19")
Workbooks.Open Filename:= _
"R:\DIR_OPERATIONS\40_USINE_BEAUVAIS\4038_ECHANGE_DEV_PRODUCTION\PSI\Complétude fiche de spécification.xlsx" _
, ReadOnly:=True

Set WsS = Workbooks("Complétude fiche de spécification.xlsx").Worksheets("Suivi")

Set Cel = WsS.Columns("A").Find(A, xlValues, xlPart)
If Not Cel Is Nothing Then
WsS.Range("A3") = "deja réalisé"
Else
WsS.Range("A" & WsS.Range("A" & Rows.Count).End(xlUp).Row + 1) = A

End If

Workbooks("Complétude fiche de spécification.xlsx").Save
Workbooks("Complétude fiche de spécification.xlsx").Close
End Sub

bonne soirée