Bonjour
Votre macro planning comme ceci
Sub Planning()
Dim TS As ListObject
Dim cel As Range
Dim col As Integer
Dim lig As Byte, i As Byte
Set TS = Range("Tab_demande_livraison").ListObject
For Each cel In TS.ListColumns(2).DataBodyRange
With Feuil2
On Error Resume Next
col = .Rows(1).Find(cel.Value, LookIn:=xlValues).Column
If Err.Number > 0 Then MsgBox "Date du " & cel.Value & " inexistante dans le planning herbdomadaire !", vbCritical, "Date inconnue": Exit Sub
lig = WorksheetFunction.Match(cel.Offset(0, 1), .Columns(1), 1)
If lig > 0 Then
For i = lig To .Range("A" & Rows.Count).End(xlUp).Row
If .Range("A" & i + 1).Text > cel.Offset(0, 2).Text Then Exit For
If TS.DataBodyRange.Item(cel.Row - TS.HeaderRowRange.Row, 7) = "Validée" Then
If .Cells(i, col) Like "*GRUE*ENTREPRISE*" Then 'verification si Grue et entreprise
MsgBox "Attention les heures choisies pour le sous-traitant " & cel.Offset(0, -1).Value & vbCrLf & _
" sont déjà occupées par ENTREPRISE ", vbOKOnly + vbCritical, "Heures incompatibles"
.Cells(i, col) = .Cells(i, col) & vbCrLf & cel.Offset(0, 4).Value & "-" & cel.Offset(0, -1).Value & "-" & cel.Offset(0, 3).Value
.Cells(i, col).Font.ColorIndex = 3 'police rouge
Else: .Cells(i, col) = cel.Offset(0, 4).Value & "-" & cel.Offset(0, -1).Value & "-" & cel.Offset(0, 3).Value
End If
End If
Next i
End If
lig = 0
End With
Next cel
End Sub
En y repensant, j'aurais dû vous le dire au départ mais vous auriez peut être dû mettre les jours en colonne A et les heures en ligne 1. Avec excel il faut toujours penser à travailler verticalement plutôt qu'horizontalement. Moins de colonnes il y a, mieux c'est
Je peux revoir si vous voulez.
Crdlt
Edit : notez que votre demande sur le Autonome qui se met automatiquement n'est pas prévue.
Si vous voulez tout de même l'avoir, je dois modifier le code Soumettre demande. Mais le plus simple serait de se passer de cette fonctionnalité au profit de la couleur rouge dans le planning qui permet de voir qu'il y a un souci. On s'évite des lignes de codes et surtout de compliquer