Copier des données par rapport à une date

Sub Copie_Donnee()
Dim Prjt As String, Dte As Date, Lign As Long, k As Long
Dim Cell As Range
With Sheets("Feuil2")
  Prjt = .Range("D1")
  Dte = .Range("A3")
End With
With Sheets("EC")
 For k = 11 To .Range("A65536").End(xlUp).Row
    If .Cells(k, 1) = Prjt Then Lign = k
 Next
 Set Cell = .Range("Q3:HL3").Find(Dte, LookIn:=xlValues)
 If Not Cell Is Nothing Then Sheets("Feuil2").Range("A4:BL4").Copy .Cells(Lign, Cell.Column)
End With
End Sub

Sub Transfert()
Dim Proj As String 'déclare la variable Proj
Dim MAD As Date 'déclare la variable MAD
Dim HeurProd As Integer 'déclare la variable HeurProd
Dim deb As Date 'déclare la variable deb
Dim li As Integer 'déclare la variable li (LIgne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim r As Range 'déclare la variable r (Recherche)
Dim dest As Range 'déclare la variable dest (DESTination)
 
With Sheets("Feuil2") 'prens en compte l'onglet "Feuil2"
    Proj = .Range("D1").Value 'définit la variable Proj
    MAD = .Range("H1").Value 'définit la variable MAD
    HeurProd = .Range("Q1").Value 'définit la variable HeurProd
    deb = .Range("A3").Value 'définit la variable deb
End With 'fin de la prise en compte de l'onglet "Feuil2"
 
Sheets("EC").Activate 'sélectionne l'onglet "EC"
li = Range("A10").End(xlDown).Offset(1, 0).Row 'définit la variable li
Cells(li, 1).Value = Proj 'place la donnée Proj
Cells(li, 4) = Format(MAD, "d/m") 'place la donnée MAD
Cells(li, 10).Value = HeurProd 'place la donnée HeurProd
Set pl = Range("Q3:" & Range("IV3").End(xlToRight).Address) 'définit la plage pl
Set r = pl.Find(deb) 'définit la variable r
'condition : si il existe au moins une occurrence de r dans pl, définit la variable dest
If Not r Is Nothing Then Set dest = Cells(li, r.Column)
'copie et colle la [lage de l'onglet "Feuil2"
Sheets("Feuil2").Range("A4:Bl4").Copy Destination:=dest
End Sub