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 Functionle 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 FunctionMerci encore, à bientôt !
Cordialement