Copie information et remplacement selon condition

Bonjour à tous,

J'utilise un fichier "de base" qui contient certaines informations. Dans l'exemple joint j'ai 4 informations : N° devis, nom, ville et état.

Ces informations sont copiées (de la Feuil1) sur un autre fichier (ici la Feuil2) pour en faire une synthèse.

Je suis amené à retourner régulièrement sur ce genre de fichier "de base" pour y apporter des modifications / actualiser les informations.

Le problème que je rencontre c'est que l'export des informations vient se rajouter sur une nouvelle ligne.

Ce que je souhaiterais, si c'est possible, c'est qu'en fonction du numéro de devis, l'export de ces informations vers la synthese (Feuil2) viennent en remplacement du numéro existant, et non à me rajouter une ligne...

Avez-vous une idée ?

Merci par avance.

Cordialement,

Bonjour FBidee

Voici le fichier modifié

Mais pour moi il n'y a que le statut à modifier

A+

Bonjour Bruno,

Oui effectivement ce n'est que l'état qui change

Je vais tenter de l'adapter en conditions réelles et ferai un retour très prochainement.

En tout cas ça semble fonctionné comme il faut !

Merci beaucoup.

Cordialement

Bonjour,

J'ai adapté mon code à mon cas, mais ça bug, pouvez-vous m'aider ?

Option Explicit

Sub ModifStatutDevis()
  Dim Sht As Worksheet
  Dim LigF As Long, NumDevis As String

  Set Sht = Sheets("Prépa devis")

  Dim FichierRecap As Workbook

  Set FichierRecap = Application.Workbooks.Open("C:\Mes documents\*****\*****.xlsm")

  ' Définir la feuille

  NumDevis = Sht.Range("U11").Value
  ' Trouver la ligne
  LigF = LigFind(NumDevis)
  ' Avec la feuille 1 du FichierRecap
  With Sheets(FichierRecap.Worksheets(1))
    ' Si pas de ligne trouvée
    If LigF = 0 Then
      ' On ajoute la ligne
    Else
      ' On modifie la ligne
      .Range("R" & LigF).Value = Sht.Range("AK11").Value
    End If
  End With
  Set Sht = Nothing
End Sub

Function LigFind(NumDevis As String) As Long
  Dim FichierRecap As Workbook
   Set FichierRecap = Application.Workbooks.Open("C:\Mes documents\*****\*****.xlsm")
  LigFind = 0
  With Sheets(FichierRecap.Worksheets(1))
    On Error Resume Next
    LigFind = .Range("A:A").Find(What:=NumDevis, LookIn:=xlValues, LookAt:=xlWhole, _
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False).Row
    On Error GoTo 0
  End With
End Function

le bug arrive au niveau de la function LigFind

With Sheets(FichierRecap.Worksheets(1)) "Incompatibilité de type 13"

Je rappel que je suis novice en VBA...

Merci.

Cdt

Re,

Ou là, ce n'est pas ce qui était présenté initialement

Vous allez chercher le devis à mettre à jour dans un autre fichier...

Navré pour vous, mais je ne reviens jamais sur ce que je me suis évertué à coder.

Bonne chance

Bonjour Bruno,

Je comprend tout à fait, pas de soucis. Pour être honnête je n'avais pas mesuré l'importance de devoir préciser !

En tâtonnant j'ai finalement réussi.

Il suffisait juste d'ouvrir le fichier cible avec Application.Workbooks.Open et de désigner la Sheet voulue.

Pour ceux que ça intéresse :

Option Explicit

Sub ModifStatutDevis()
  Dim Sht As Worksheet
  Dim LigF As Long, NumDevis As String

  Set Sht = Sheets("Prépa devis")

  Application.Workbooks.Open ("C:\Mes documents\***\***.xlsm")

  ' Définir la feuille

  NumDevis = Sht.Range("U11").Value
  ' Trouver la ligne
  LigF = LigFind(NumDevis)
  ' Avec la feuille 2
  With Sheets("Récap prépa")
    ' Si pas de ligne trouvée
    If LigF = 0 Then
      ' On ajoute la ligne
    Else
      ' On modifie la ligne
      .Range("R" & LigF).Value = Sht.Range("AK11").Value
    End If
  End With
  Set Sht = Nothing
End Sub

Function LigFind(NumDevis As String) As Long

  LigFind = 0
  With Sheets("Récap prépa")
    On Error Resume Next
    LigFind = .Range("A:A").Find(What:=NumDevis, LookIn:=xlValues, LookAt:=xlWhole, _
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False).Row
    On Error GoTo 0
  End With
End Function

Merci encore, à bientôt !

Cordialement

Rechercher des sujets similaires à "copie information remplacement condition"