Excel Vba Chercher dans un autre fichier Résolu

Question

Bonjour,

Je souhaiterai réaliser une macro sous Vba.
Je dispose de deux fichiers différents:[list]
[*]Un formulaire contenant un numéro de lot dans un onglet (cellule 05)
[*]Un fichier de synthèse où l'ensemble des données des formulaires sont importées[/list]

Avant l'exportation des données du formulaire vers le fichier de synthèse, je souhaiterai tester le numéro de lot, afin de savoir si ce formulaire est déjà rentré dans la fiche de synthèse.

Sachant que les numéros de lot sont dans la colonne C à partir de la ligne 6, j'essaye donc de regarder si par hasard on ne retrouve pas la valeur de 05 du formulaire dans la fiche de synthèse colonne C.

Voici mon code inefficace sous Vba:
Sub Macro4()
Dim Wb As Excel.Workbook
   Nom1 = Range("O5")
   Workbooks.Open Filename:="C:\Users\Ben\Desktop\Trash Test\copie expurgee de synthèse RNC 2005.xls"
   Windows("copie expurgee de synthèse RNC 2005.xls").Activate
    i = 6
    Do Until Worksheets("Répertoire RNC").Cells(i, 3).Value = Nom1
    MsgBox "Le Numéro de lot " & Nom1 & " existe déjà, merci d'augmenter l'indice avec la mollette "
    i = i + 1
    Loop
    MsgBox "Le Numéro de lot " & Nom1 & " n'existe pas, vous pouvez importer les données et enregistrer le RNC "
    ActiveWorkbook.Close
End Sub

Je ne connais pas les commandes RechercheH et RechercheV, et malgré les tuto sur le site je n'arrive pas à les appliquer à ce cas.

Je vous remercie d'avance pour vos conseils avisés.
Bonne journée

Benjamin35008 · Answer

Personne a une petite idée s'il vous plait?

xkristi · Answer

Salut !

Si tu mettais ton fichier sur cjoint.com
et que tu nous donnes le lien 
Ce serait plus simple pour nous de répondre.

une simple Recherchev pourrait peut-être suffire ...

michel_m · Answer

Bonjour,

essaies cette modif d'une partie de ta procédure
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\Users\Ben\Desktop\Trash Test\copie expurgee de synthèse RNC 2005.xls"
If Application.CountIf(Worksheets("Répertoire RNC").Range("C6:C1000"), nom1) > 0 Then 'C6:C1000 à adapter
    MsgBox "Le Numéro de lot " & nom1 & " existe déjà, merci d'augmenter l'indice avec la mollette "
Else
    MsgBox "Le Numéro de lot " & nom1 & " n'existe pas, vous pouvez importer les données et enregistrer le RNC "
End If
ActiveWorkbook.Close

a quoi sert
Dim Wb As Excel.Workbook

il serait plus prudent de préciser le nom de l'onglet où tu as la cellule "O5"
nom1=sheets(....).range("O5")

Benjamin35008 · Answer

Bonjour xkristi, 
Pour des raisons de confidentialité je ne peux malheuresement pas vous transmettre ces classeurs, si ça ne tenait qu'à moi je le ferai sans aucun problême, mais l'entreprise est assez à cheval là dessus, et je serai passible de 5ans de cabane.

Merci michel-m, je vais essayer ça dès que je serai rentré chez moi.
 le dim wb as Exce... c'est une ligne que je mets toujours en debut de code vba pour des soucis de comptabilité mais il peut s'avérer que ce soit inutile en effet.

Je vous tiens au courant et merci pour vos réactions

Benjamin35008 · Answer

Ca marche merci beaucoup. Je mettrai le code final ce soir.

Un grand merci. Bonne soirée

Benjamin35008 · Answer

Sub Macro4()
' Macro 4 Module 3 Fonction Tester le n° de RNC
' Macro enregistrée le 19/12/2009 par XXXXX

Dim Wb As Excel.Workbook
Dim Nom1 As String

   Nom1 = Range("O5")
   Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\Users\Ben\Desktop\Versions finales\copie expurgee de synthèse RNC 2005.xls"
        If Application.CountIf(Worksheets("Répertoire RNC").Range("C6:C1000"), Nom1) > 0 Then 'C6:C1000 à adapter
    MsgBox "Le Numéro de lot " & Nom1 & " existe déjà dans la base Synthèse des RNC, merci d'augmenter l'indice avec la mollette "
Else
    MsgBox "Le Numéro de lot " & Nom1 & " n'existe pas, vous pouvez importer les données et enregistrer le RNC "
End If

ActiveWorkbook.Save
ActiveWorkbook.Close

End Sub

Excel Vba Chercher dans un autre fichier

6 réponses

Discussions similaires

Newsletters