bonjour,
 
j'ai un petit problème avec une macro pour un fichier "pense bête"!
 
Je suis obligé de cliquer une seconde fois sur le bouton de la macro
lorsque les dates terminées se trouvent en tête et qu'il y en a plus d'une!
 
 
 
Sub Selectionner_1()
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 Then
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 Or Cells(i, 2).Value = Date + 3 Or Cells(i, 2).Value = Date + 4 Or Cells(i, 2).Value = Date + 5 Then
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 = "" Then
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 For
Else
Cells(h + 1, 2).Select
End If
Next h ''''' fin h
ElseIf Cells(i, 2).Value = Date 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"
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 <> "" 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
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/?BDukmUUMIyc
 
Merci!

Bonjour,
Je ne télécharge pas de fichier et ton code est illisible.
 
 
 
 
Peut-être peux tu nous expliquer un peu mieux ton problème parce que :

Pour moi, ce n'est vraiment pas clair.
 
 
 
 
 
à première vue, tu peux déjà remplacer les if / elseIf par des select case + indenter ton code  

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+