Boucle qui fonctionne à moitié

Bonjour,
Je rencontre un petit souci sur une macro qui doit récupérer des infos sur une feuille pour les placer sur une autre. La boucle ne va pas jusqu'au bout pour prendre toutes les valeurs.
Etant donnée mon petit niveau en VBA je sollicite votre aide. Merci d'avance pour votre aide.
image des feuilles.





Le code est le suivant:

Sub MaRécup()
Dim ws As Worksheet
Dim col_en_cours As Long
Dim Der_col As Long
Dim ligne_en_cours As Long
Dim Der_lin As Long
Dim CM As Range
Dim AR As Range
Dim AIG As Range
Dim RD As Range
Dim RD1 As Range

Set ws = Feuil1
Der_col = ws.Cells(1, Columns.Count).End(xlToLeft).Column
Der_lin = ws.Cells(Rows.Count, 1).End(xlUp).Row

For col_en_cours = 1 To Der_col
For i = 1 To 32
If Cells(i, col_en_cours).Value = Date Then
Cells(i, col_en_cours).Interior.ColorIndex = 4
Cells(i, col_en_cours).Select
With Selection
For ligne_en_cours = 1 To Der_lin
For j = 1 To 7
If Cells(j, col_en_cours).Value = "CM" Then
Cells(j, col_en_cours).EntireRow.End(xlToLeft).Select
Selection.Copy
With Selection
Sheets("lundi").Activate
Set CM = Worksheets("lundi").Cells.Find(What:="CM", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not CM Is Nothing Then
CM.Offset(0, 1).Select
ActiveCell = ClearContents
Selection.PasteSpecial xlValues
Application.CutCopyMode = xlCut
End If
End With

ElseIf Cells(j, col_en_cours).Value = "AR" Then
Cells(j, col_en_cours).EntireRow.End(xlToLeft).Select
Selection.Copy
With Selection
Sheets("lundi").Activate
Set AR = Worksheets("lundi").Cells.Find(What:="AR", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not AR Is Nothing Then
AR.Offset(0, 1).Select
ActiveCell = ClearContents
Selection.PasteSpecial xlValues
Application.CutCopyMode = xlCut
End If
End With

ElseIf Cells(j, col_en_cours).Value = "AIG" Then
Cells(j, col_en_cours).EntireRow.End(xlToLeft).Select
Selection.Copy
With Selection
Sheets("lundi").Activate
Set AIG = Worksheets("lundi").Cells.Find(What:="AIG", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not AIG Is Nothing Then
AIG.Offset(0, 1).Select
ActiveCell = ClearContents
Selection.PasteSpecial xlValues
Application.CutCopyMode = xlCut
End If
End With

ElseIf Cells(j, col_en_cours).Value = "RD" Then
Cells(j, col_en_cours).EntireRow.End(xlToLeft).Select
Selection.Copy
With Selection
Sheets("lundi").Activate
Set RD = Worksheets("lundi").Cells.Find(What:="RD", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not RD Is Nothing Then
RD.Offset(0, 1).Select
ActiveCell = ClearContents
Selection.PasteSpecial xlValues
Application.CutCopyMode = xlCut
End If
End With

ElseIf Cells(j, col_en_cours).Value = "RD1" Then
Cells(j, col_en_cours).EntireRow.End(xlToLeft).Select
Selection.Copy
With Selection
Sheets("lundi").Activate
Set RD1 = Worksheets("lundi").Cells.Find(What:="RD1", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not RD1 Is Nothing Then
RD1.Offset(0, 1).Select
ActiveCell = ClearContents
Selection.PasteSpecial xlValues
Application.CutCopyMode = xlCut
End If
End With
End If
Next
Next
End With
End If
Next
Next

End Sub