VBA : retrouver valeurs et les importer

[boby63]

Bonjour
Ci-joint en feuille1 une extraction (anonymisée) d'un logiciel
En feuille2 une extraction brute (régulière) d'une page web
Je souhaiterai, par vba svp, aller chercher dans la feuille 2, colonneD, les tarifs et les attribuer à la colonne M de la feuille1.
Les "clés uniques" se trouvent en colonne I de la feuille1 et A de la feuille2
1. Seuls les lignes de la feuille 1 ayant "vrai en colone U doivent se mettre à jour.
2. Si "vrai" mais ne trouve pas de correspondance (c'est le cas dans ce fichier une fois je crois), ne rien faire sur cette ligne.
Merci d'avance

 

[Compte Supprimé 979]

Bonsoir boby63,

Voici une possibilité

Sub MàJPrix()
  Dim DLig As Long, Lig As Long
  Dim Prix As Double, Ref As Integer
  ' Avec la feuille nommée
  With Sheets("Logiciel")
    ' Dernière ligne de la feuille
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For Lig = 2 To DLig
      ' Vérifier si la colonne tt20 est vrai
      If .Range("U" & Lig).Value = True Then
        ' Récupérer le numéro de ref (si j'ai bien tout compris)
        Ref = .Range("I" & Lig).Value
        ' Trouver le prix dans la feuille Net et l'inscrire
        Prix = vFindR("Net", "A:A", Ref, "D")
        If Prix <> 0 Then
          ' Correspondance trouvée, inscrire le prix
          .Range("M" & Lig).Value = Prix
          ' Mettre la cellule en vert
          .Range("M" & Lig).Interior.ColorIndex = 43
        Else
          ' Pas de correspondance, mettre la cellule en orange pour l'indiquer
          .Range("M" & Lig).Interior.ColorIndex = 44
        End If
      End If
    Next Lig
  End With
End Sub

Function vFindR(sFeuil As String, sCol As String, Quoi As Variant, ColR As String)
  Dim LigFind As Long
  ' sFeuil = nom de la feuille dans laquelle chercher
  ' sCol = Colonne de recherche
  ' Quoi = Valeur à chercher
  ' ColR = Colonne de retour de la valeur
  vFindR = "": LigFind = 0
  ' Effectue la recherche
  On Error Resume Next
  With Sheets(sFeuil).Range(sCol)
    LigFind = .Find(What:=Quoi, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                    MatchCase:=False, SearchFormat:=False).Row
    If Err.Number = 0 Then
      vFindR = Sheets(sFeuil).Range(ColR & LigFind).Value
    Else
      vFindR = 0
    End If
  End With
  On Error GoTo 0
End Function

Code à mettre dans un module de ton classeur

A+

 

[boby63]

Bonjour
Ça me semble parfait.
Merci beaucoup et bonne journée