Correction de Code VBA pour généré un programme de livraison

bonjour, je veux modifier le code suivant pour qu'il permette de remplacé à partir du tableau des réserves les préposés ou chauffeurs absents en respectant certaines interdictions et certaines conditions liées à des jours précis de semaine. voici le code :

Sub RemplacerAbsents()
Dim ws As Worksheet
Dim lastRow As Long
Dim reserveLastRow As Long
Dim i As Long, j As Long
Dim prepose As String
Dim destination As String
Dim jourSemaine As String
Dim reservePrepose As String
Dim reserveChauffeur As String
Dim statutPreposeReserve As String
Dim trouveRemplacement As Boolean
Dim reservesUtilises As Collection
Dim nouvelTableau As ListObject
Dim ligne As ListRow

' Demander le jour de la semaine
jourSemaine = InputBox("Veuillez entrer le jour de la semaine (ex: lundi, mardi, etc.) :", "Jour de la Semaine")

' Vérifier si le jour de la semaine est valide
If jourSemaine = "" Then
MsgBox "Aucune entrée pour le jour de la semaine. Le processus est annulé.", vbExclamation
Exit Sub
End If

' Définir la feuille de calcul
Set ws = ThisWorkbook.Sheets("Rotation")

' Dernière ligne dans le tableau principal (Programme Journalier)
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

' Dernière ligne dans le tableau des réserves
reserveLastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row

' Créer une nouvelle collection pour garder une trace des réserves utilisées
Set reservesUtilises = New Collection

' Création d'un tableau pour les remplacements
Set nouvelTableau = ws.ListObjects.Add(xlSrcRange, ws.Range("A1").CurrentRegion.Offset(lastRow + 2, 0).Resize(1, 4), , xlYes)

With nouvelTableau
.Name = "ProgrammeDuPremierJourDeReserve"
.HeaderRowRange.Cells(1, 1).Value = "Préposé"
.HeaderRowRange.Cells(1, 2).Value = "Chauffeur"
.HeaderRowRange.Cells(1, 3).Value = "Destination"
.HeaderRowRange.Cells(1, 4).Value = "Remplace Préposé"
End With

' Boucle sur chaque préposé dans le tableau principal (Programme Journalier)
For i = 2 To lastRow
If ws.Cells(i, 4).Value <> "" Then ' Si le préposé est absent (statut non vide)
prepose = ws.Cells(i, 1).Value
destination = ws.Cells(i, 3).Value
trouveRemplacement = False ' Réinitialiser le flag

' Boucle sur les préposés de réserve (colonnes I à L, à partir de la ligne 3)
For j = 3 To reserveLastRow
reservePrepose = ws.Cells(j, 9).Value ' Colonne I (Préposé)
reserveChauffeur = ws.Cells(j, 10).Value ' Colonne J (Chauffeur)
statutPreposeReserve = ws.Cells(j, 11).Value ' Colonne K (État Préposé)

' Vérifier si le préposé de réserve est disponible et non utilisé
If statutPreposeReserve = "" Then ' Si le préposé de réserve est présent (pas d'absence)

' Vérifier si ce préposé de réserve a déjà été utilisé
On Error Resume Next
reservesUtilises.Add reservePrepose, reservePrepose
If Err.Number = 0 Then
' Si pas encore utilisé, vérifions les critères d'interdictions
Dim peutRemplacer As Boolean
peutRemplacer = True ' Initialiser à vrai

' Vérification des interdictions selon le jour et la destination
Select Case reservePrepose
Case "Reserve1"
If (jourSemaine = "mardi" Or jourSemaine = "jeudi") And (destination = "Tebessa" Or destination = "Constantine1") Then peutRemplacer = False
Case "Reserve2"
If (jourSemaine = "mardi" Or jourSemaine = "jeudi") And (destination = "Khenchela" Or destination = "Annaba1") Then peutRemplacer = False
Case "Reserve3"
If (jourSemaine = "dimanche" Or jourSemaine = "mardi") And destination = "Batna2" Then peutRemplacer = False
Case "Reserve4"
If destination = "Guelma" Or destination = "Biskra" Then peutRemplacer = False
Case "Reserve5"
If destination = "OEB" Or destination = "BBA" Then peutRemplacer = False
Case "Reserve6"
If (jourSemaine = "dimanche" Or jourSemaine = "mardi") And (destination = "Souk Ahras" Or destination = "SETIF2") Then peutRemplacer = False
Case "Reserve7"
If destination = "Setif3" Or destination = "Skikda1" Then peutRemplacer = False
Case "Reserve8"
If destination = "Annaba2" Or destination = "Batna1" Then peutRemplacer = False
End Select

' Si les critères sont respectés
If peutRemplacer Then
' Ajouter le remplacement dans le tableau "Programme du Premier Jour de Réserve"
Set ligne = nouvelTableau.ListRows.Add
ligne.Range.Cells(1, 1).Value = reservePrepose
ligne.Range.Cells(1, 2).Value = reserveChauffeur ' Remplacer le chauffeur s'il est aussi absent
ligne.Range.Cells(1, 3).Value = destination
ligne.Range.Cells(1, 4).Value = prepose ' Remplace le préposé absent

' Marquer que nous avons trouvé un remplacement
trouveRemplacement = True

' Sortir de la boucle après avoir trouvé un remplacement
Exit For
End If
End If
On Error GoTo 0
End If
Next j

' Si aucun remplacement n'est trouvé, afficher un message
If Not trouveRemplacement Then
MsgBox "Aucun préposé de réserve disponible pour la destination: " & destination, vbInformation
End If
End If
Next i
End Sub

le problème c'est que le code ne reconnait pas la première ligne de données du tableau RESERVES et lors du replacement de 08 préposés absents de la rotation par 08 préposés de réserves il lui est échappe le Reserve1 il lui affecte n'importe quoi "Destination" et par conséquent il ne trouve pas de préposé de réserve pour assuré la 8 destination du 8 préposé absent.

merci pour une aide urgente.

Bonjour,

Pour commencer, vous devriez lire/relire la charte de ce forum
[A LIRE AVANT DE POSTER] Charte du forum et informations utiles

Ou il est indiqué :

4. Joignez (si possible) un fichier pour augmenter vos chances d'obtenir de l'aide en cliquant sur le bouton Fichier de l'éditeur. Si votre fichier est trop lourd ou contient des données personnelles, créez une version allégée de votre fichier avec juste assez d'informations pour permettre de comprendre votre problème. Dans tous les cas, ne postez JAMAIS de fichiers avec des informations personnelles ou confidentielles (cet utilitaire peut vous aider à les retirer).

En revanche, il est dommage qu'il ne soit pas inscrit que la notion d'urgence est à bannir nous sommes tous bénévoles ici !

bonsoir merci pour votre réponse et pour votre remarque.

Rechercher des sujets similaires à "correction code vba genere programme livraison"