Re?
Une mise à jour à adapter !?
Cdlt.
Public Sub Transfert_2()
Dim lo As ListObject, dt As Long, tbl, rw, r As Range, n As Double
With Worksheets("Feuil1")
Set r = .Cells(26, 3).Resize(, 5)
n = WorksheetFunction.CountA(r)
If n = 5 Then
With .Cells(26, 3)
dt = .Value
tbl = .Offset(, 1).Resize(, 4).Value
End With
Set lo = Range("Tab_JRS").ListObject
rw = Application.Match(dt, lo.ListColumns("Date").DataBodyRange, 0)
If IsError(rw) Then
MsgBox " La date n'est pas dans l'intervalle !...", 64, "Transfert"
Else
lo.DataBodyRange.Cells(rw, 4).Resize(, 4).Value = tbl
MsgBox "Transfert réalisé !...", 64, "Transfert"
End If
Else
MsgBox "La procédure ne peut pas être exécutée !...", 64, "Information"
End If
End With
End Sub