Evenement worksheet change, copier coller ligne dans autre classeur
Bonjour à tous, je vais essayer d'être clair.
J'ai une feuille dans un classeur dans laquelle je souhaite qu'une modification entraine la copie de la ligne sur laquelle cette modif a eu lieu puis colle cette même ligne dans un autre classeur, sur une ligne spécifiée.
En résumé, si je modifie une cellule sur mon premier classeur, la ligne entière est sélectionnée, puis copiée, le second classeur s'ouvre, on recherche la ligne correspondante (la ligne 7 ne correspond pas forcément à la ligne 7 dans l'autre classeur, on passe par un trigrammedonné à chaque ligne), puis on colle la ligne entière sur celle-ci.
J'ai le code suivant pour le moment mais je m'embrouille sur la recherche du trigramme dans le second classeur et la macro tourne à l'infini:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Wbkin As Workbook, Wbkout As Workbook
Dim KeyChange As Range
Dim LigneRecherche As String
Dim Numb As Integer
Dim valeurRecherche As Range
Set KeyChange = Range("A2:T" & Cells(Rows.Count, "T").End(xlUp).Row)
Application.DisplayAlerts = False
Set Wbkin = Workbooks("Suivi Meeting IC.xlsm")
Set Wbkout = Workbooks.Open("F:\GVA-COMMUN\SecureDoc\Crypt_Investment_Advisory\ADV Tool\Suivi Activité Consolidé.xlsm")
Wbkin.Sheets("ADV").Activate
Numb = Target.Row
Set valeurRecherche = Wbkin.Sheets("ADV").Range("S" & Numb)
If Not Application.Intersect(KeyChange, Range(Target.Address)) Is Nothing Then Target.EntireRow.Copy
Wbkout.Activate
LigneRecherche = Cells.Find(What:=valeurRecherche).Row
Range("A" & LigneRecherche).PasteSpecial Paste:=xlPasteFormulas
Wbkout.Save
Wbkout.Close
End Sub
Est-ce que qqn pourrait jeter un oeil et me guider svp?
Merci par avance!
Petite MAJ,
J'ai maintenant
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Wbkin As Workbook, Wbkout As Workbook
Dim Recherche As Range
Dim KeyChange As Range
Dim LigneRecherche As Double
Dim valeurRecherche As String
Set KeyChange = Range("A2:T" & Cells(Rows.Count, "T").End(xlUp).Row)
Application.DisplayAlerts = False
Set Wbkin = Workbooks("Suivi Meeting IC.xlsm")
Set Wbkout = Workbooks.Open("F:\GVA-COMMUN\SecureDoc\Crypt_Investment_Advisory\ADV Tool\Suivi Activité Consolidé.xlsm")
valeurRecherche = Wbkin.Sheets("ADV").Range("S" & Target.Row)
If Not Application.Intersect(KeyChange, Range(Target.Address)) Is Nothing Then Target.EntireRow.Copy
With Wbkout.Columns("S")
Set Recherche = Cells.Find(What:=valeurRecherche)
If Not Recherche Is Nothing Then
LigneRecherche = Recherche.Row
Wbkout.Range("A" & LigneRecherche).PasteSpecial Paste:=xlPasteFormulas
Exit Sub
MsgBox ("Valeur " & valeurRecherche & " non trouvée")
End If
End With
Wbkout.Save
Wbkout.Close
Wbkin.Activate
End Sub
avec un souci sur la ligne With Wbkout.Columns("S"), qqn peut il m'aider svp<<<<<<<'
Merci