C'est bon ! J'ai rajouté une deuxième macro pour remédier aux problèmes de lignes supprimées dans plusieurs boucles !
Merci oovaveoo d'avoir planché sur mon problème !
Sub Selection_Premier()
Dim j As Integer
Application.ScreenUpdating = False
Sheets("Date_En_Cours" ).Select
Range("B2" ).Select
For j = 2 To Range("A1" ).End(xlDown).Row ''''' debut i
If Cells(j, 2).Value = "" Then Exit For
If Cells(j, 8).Value = 1 Then
Cells(j + 1, 2).Select
Else
Selectionner
Cells(j + 1, 2).Select
End If
Next j
Range("H:H" ).ClearContents
Application.ScreenUpdating = True
End Sub
Sub Selectionner()
Application.ScreenUpdating = False
Dim i As Integer
Dim k As Integer
Dim h As Integer
Sheets("Date_En_Cours" ).Select
Range("B2" ).Select
For i = 2 To Range("A1" ).End(xlDown).Row ''''' debut i
If Cells(i, 2).Value = "" Then Exit For
Cells(i, 7).FormulaR1C1 = _
"=IF(WEEKDAY(RC[-5],2)=1,""Lundi"",IF(WEEKDAY(RC[-5],2)=2,""Mardi"",IF(WEEKDAY(RC[-5],2)=3,""Mercredi"",IF(WEEKDAY(RC[-5],2)=4,""Jeudi"",IF(WEEKDAY(RC[-5],2)=5,""Vendredi"",IF(WEEKDAY(RC[-5],2)=6,""Samedi"",IF(WEEKDAY(RC[-5],2)=7,""Dimanche"","""" )))))))"
If Cells(i, 1).Interior.ColorIndex = xlNone Then
Range(Cells(i, 1), Cells(i, 6)).Interior.ColorIndex = 24
ElseIf Cells(i, 2).Value = Date + 1 And Cells(i, 8).Value = "" Then
Cells(i, 8).Value = 1
MsgBox Cells(i, 1) & " à venir " & Cells(i, 7) & " le " & Cells(i, 2) & " à Heure " & Cells(i, 3) & " J" & Date - Cells(i, 2)
Range(Cells(i, 1), Cells(i, 7)).Interior.ColorIndex = 6
Cells(i, 6).Value = Date - Cells(i, 2)
ElseIf Cells(i, 2).Value = Date + 2 And Cells(i, 8).Value = "" Then
Cells(i, 8).Value = 1
MsgBox Cells(i, 1) & " à venir " & Cells(i, 7) & " le " & Cells(i, 2) & " à Heure " & Cells(i, 3) & " J" & Date - Cells(i, 2)
Range(Cells(i, 1), Cells(i, 7)).Interior.ColorIndex = 8 ''' Bleue
Cells(i, 6).Value = Date - Cells(i, 2)
ElseIf Cells(i, 2).Value = Date + 3 And Cells(i, 8).Value = "" Then
Cells(i, 8).Value = 1
MsgBox Cells(i, 1) & " à venir " & Cells(i, 7) & " le " & Cells(i, 2) & " à Heure " & Cells(i, 3) & " J" & Date - Cells(i, 2)
Range(Cells(i, 1), Cells(i, 7)).Interior.ColorIndex = 8 ''' Bleue
Cells(i, 6).Value = Date - Cells(i, 2)
ElseIf Cells(i, 2).Value = Date + 4 And Cells(i, 8).Value = "" Then
Cells(i, 8).Value = 1
MsgBox Cells(i, 1) & " à venir " & Cells(i, 7) & " le " & Cells(i, 2) & " à Heure " & Cells(i, 3) & " J" & Date - Cells(i, 2)
Range(Cells(i, 1), Cells(i, 7)).Interior.ColorIndex = 8 ''' Bleue
Cells(i, 6).Value = Date - Cells(i, 2)
ElseIf Cells(i, 2).Value = Date + 5 And Cells(i, 8).Value = "" Then
Cells(i, 8).Value = 1
MsgBox Cells(i, 1) & " à venir " & Cells(i, 7) & " le " & Cells(i, 2) & " à Heure " & Cells(i, 3) & " J" & Date - Cells(i, 2)
Range(Cells(i, 1), Cells(i, 7)).Interior.ColorIndex = 8 ''' Bleue
Cells(i, 6).Value = Date - Cells(i, 2)
ElseIf Cells(i, 2).Value > Date + 5 Then
Range(Cells(i, 1), Cells(i, 6)).Interior.ColorIndex = 24 ''' Violet
ElseIf Cells(i, 2).Value < Date And Cells(i, 5).Value = "" And Cells(i, 8).Value = "" Then
Cells(i, 8).Value = 1
MsgBox Cells(i, 1) & " Date Terminée "
Range(Cells(i, 1), Cells(i, 7)).Copy
Sheets("Date_Terminée" ).Select
Cells(2, 2).Select
For k = 2 To 30000 ''''' debut k
If Cells(k, 2).Value = "" Then
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range(Cells(k, 2), Cells(k, 8)).Interior.ColorIndex = xlNone ''''' Blanc
Sheets("Date_En_Cours" ).Select
Exit For
Else
Cells(k + 1, 2).Select
End If
Next k ''''' fin k
Range("B2" ).Select
For h = 2 To Range("A1" ).End(xlDown).Row ''''' debut h
If Cells(h, 2).Value = "" Then Exit For
If Cells(h, 2).Value < Date Then
Cells(h, 2).EntireRow.Delete
Exit Sub
'Exit For
Else
Cells(h + 1, 2).Select
End If
Next h ''''' fin h
ElseIf Cells(i, 2).Value = Date And Cells(i, 8).Value = "" Then
MsgBox Cells(i, 1) & " AUJOURD'HUI " & Cells(i, 7) & " le " & Cells(i, 2) & " à Heure " & Cells(i, 3)
Range(Cells(i, 1), Cells(i, 7)).Interior.ColorIndex = 3 '''' rouge
Cells(i, 6).Value = "0"
Cells(i, 8).Value = 1
ElseIf Cells(i, 2).Value < Date And Cells(i, 5).Value = "" Then
Range(Cells(i, 1), Cells(i, 4)).Interior.ColorIndex = 35
Cells(i, 6).Clear
Cells(i, 3).Clear
ElseIf Cells(i, 2).Value < Date And Cells(i, 5).Value <> "" And Cells(i, 8).Value = "" Then
MsgBox Cells(i, 1) & " Date Terminée & à plus tard "
Cells(i, 2).Value = Cells(i, 2) + Cells(i, 5)
Cells(i, 6).Clear
Cells(i, 3).Clear
Cells(i, 8).Value = 1
Range(Cells(i, 1), Cells(i, 6)).Interior.ColorIndex = 24 ''''' Violet
Else
Cells(i + 1, 2).Select
End If
Next i ''''' fin i
Application.ScreenUpdating = True
End Sub
http://cjoint.com/?BDup4a4IFcK
A+
