renvoi la donnée si trouve la meme date

Sub majlundi()
Dim NomSem As String
Dim P As Variant
Dim c As Range
NomSem = "S1" 'ActiveSheet.Name
Sheets(NomSem).Activate
Sheets("congés").Select
Application.ScreenUpdating = False
For Each c In [A5:A54]
P = Application.Match(c, Application.Index(Sheets("S1").Range("b4:i107"), , 1), 0)
If Not IsError(P) Then
Sheets(NomSem).Range("b4:i107").Cells(P, 8).copy
Sheets("congés").Select
c.Offset(0, 2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone
End If
Next c
Application.ScreenUpdating = True
Sheets(NomSem).Activate
Application.CutCopyMode = False
End Sub

Cliquez pour agrandir...