Bonjour,
Une autre proposition à adapter
.ALT F8 puis exécuter la procédure CopyData
Cdlt.
Public Sub CopyData()
Dim nm As String, Rng As Range, rw, lr As ListRow, r As Range
With ActiveSheet
nm = .Cells(4, 3).Value
Set Rng = .Cells(6, 4).Resize(, 2)
End With
With Range("Tableau1").ListObject
On Error Resume Next
rw = Application.Match(nm, .ListColumns(1).DataBodyRange, 0)
If Not IsError(rw) Then
Set lr = .ListRows(rw)
Set r = lr.Range.Find("")
If Not r Is Nothing Then r.Resize(, 2).Value = Rng.Value
End If
End With
End Sub