XL 2021 VBA Prélèvement d'une donnée si une valeur recherchée est identique

[ZiM]

Bonjour à tous et comme c'est encore l'heure, bonne année 2024 !

Je viens vous demander un coup de pouce car je buche depuis quelques temps sur une macro qui ne veux pas produire les résultats demandés.
Par avance un grand merci à ceux qui vont lire (et pourquoi pas trouver une solution ^^).

Voici le contexte, je dispose d'un classeur pour aller piocher des valorisation dans deux base (cette partie marche impeccablement).
Dans ma feuille dite "Calc", je dispose d'une mise en forme standard (si le classeur est > à la V2).

De mon classeur N, je souhaite pouvoir :
- aller choisir et ouvrir le classeur N-1
- sur la feuille "Calc" du classeur N, plage B6:BXXX, si la référence unique présente est identifiée dans le classeur N-1 feuille "Calc" quelque part dans B6:BYYY (emplacement différent chaque année).
- Si la valeur est trouvée, je copie ligne i colonne F de mon classeur N-1 pour l'intégrer dans mon classeur N en ligne i de la colonne F.

Petit message, je ferme le classeur N-1 et hop.

Voici la mise en forme du classeur :

Et voici le code qui ne fait pas la copie de F pour l'heure :

Sub RepriseN1_Valeurs()
        
    Dim WbInvN, WbInvN1 As Workbook
    Dim WsCalcN, WsCalcN1 As Worksheet
    Dim lastRow, i As Long
    Dim searchValue, result As Variant
    Dim Msg As String
        
    ' ---- Message d'accueil
    Msg = "ATTENTION : Ceci reprend UNIQUEMENT les dates depuis N-1 : " & Chr(13)
    Msg = Msg & " - pour les "N° de travail" présents en N-1 , " & Chr(13)
    Msg = Msg & "Voulez-vous continuer ?"
    reponse = MsgBox(Msg, vbOKCancel, "Récupération des dates N-1.")
    If reponse = 2 Then Exit Sub
      
    'On Error GoTo Error1
    ' Ici je vérifie si non vide car c'est ici qu'une macro précédente stock le classeur à ouvrir.
    If Sheets("Var").Cells(20, 2) <> "" Then
    '  Ouvrir le classeur destination
        Set WbInvN1 = Workbooks.Open(ThisWorkbook.Sheets("Var").Cells(20, 2))
            ' Je vérifie si le classeur N-1 est sup à la V2 sinon la donnée Unique B ne sera pas présente
            If WbInvN1.Sheets("Versions").Cells(2, 2).Value > 2 Then
    
    ' Déclarer ce classuer comme WbInvN
    Set WbInvN = ThisWorkbook
    
    ' Déclarer les classeurs + feuilles
    Set WsCalcN = WbInvN.Sheets("Calc")
    Set WsCalcN1 = WbInvN1.Sheets("Calc")
    
    ' Trouver la dernière ligne dans la colonne B de WbInvN
    lastRow = WsCalcN.Cells(WsCalcN.Rows.Count, "B").End(xlUp).Row
    
    ' Parcourir chaque cellule de la colonne B de WbInvN (classeur N)
    For i = 6 To lastRow
        searchValue = WsCalcN.Cells(i, "B").Value
        ' Rechercher la valeur dans la colonne B de WbInvN1
        If result = "" Then
        
        ' Si non trouvé, ne rien faire sinon cela plante
        
        Else
            result = Application.WorksheetFunction.VLookup(searchValue, WsCalcN1.Range("B:B"), 1, False)
            If Not IsError(result) Then
                ' Si la valeur est trouvée, coller le résultat de la colonne F de WbInvN1 dans WbInvN en face de la valeur trouvée
                WsCalcN.Cells(i, "F").Value = result
            End If
        End If
    Next i
    End If
    ' Fermer le classeur source
    WbInvN1.Close SaveChanges:=False
        
    MsgBox "Les données ont été copiées avec succès."
    
    Else
        MsgBox ("Le fichier N-1 n'est pas sélectionné.")
        Exit Sub
    End If
    Exit Sub
Error1:
    WbInvN1.Close SaveChanges:=False
    WbInvN.Sheets("PDC").Activate
    MsgBox ("Erreur, fin de la reprise.")
    Exit Sub

End Sub

Si vous avez une idée de pourquoi ma procédure ne fonctionne pas ^^

Bonne journée à vous

 

[Franc58]

Bonjour, si tu veux une valeur de la colonne F, dans cette ligne de code le 1 doit être remplacé par un 5:
result = Application.WorksheetFunction.VLookup(searchValue, WsCalcN1.Range("B:B"), 5, False)

 

[job75]

Bonjour, et remplacer Range("B:B") par Range("B:F")

 

[ZiM]

Merci d'avoir pris le temps de me lire.

J'ai cumulé vos deux modification RAZ c'est vide et sans erreur :/

Sauf si je n'ai pas compris ce que j'essaie de faire le but des valeurs B:B et colonne 1 c'est de fixer la ligne de la source. Après je prends la valeur de F de la source vers la destination.