Noms pour réservations multiples sur Planning

bonjour ,

je cherche encore et toujours une solution pour faire apparaitre les noms des gens qui ont réservé sur mon planning pour chaque véhicule, en sachant qu'une personne peut louer plusieurs véhicules :

Les véhicules concernés sont dans les colonnes E,F,G de la feuille "Réservation"

Si un ame charitable se propose de m'aider

Merci pour votre aide

Option Explicit

Dim fr, fp, ln, i, hd, hr, cold, colr, cell

Private Sub Worksheet_Deactivate()

Set fr = Sheets("Réservation")

Set fp = Sheets("Planning")

'Initialisation du planning

fp.Range(fp.Cells(3, 2), fp.Cells(fp.Cells(Rows.Count, 1).End(xlUp).Row, fp.Cells(2, Columns.Count).End(xlToLeft).Column)).ClearContents

fp.Range(fp.Cells(3, 2), fp.Cells(fp.Cells(Rows.Count, 1).End(xlUp).Row, fp.Cells(2, Columns.Count).End(xlToLeft).Column)).Interior.Color = xlNone

'Boucles

For ln = 3 To fp.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To fr.Range("E,F,G" & Rows.Count).End(xlUp).Row

If fp.Range("A" & ln) = fr.Range("E,F,G" & i) Then

hd = fr.Range("J" & i)

hr = fr.Range("K" & i)

Set cell = fp.Rows("2:2").Find(hd, lookat:=xlWhole)

If Not cell Is Nothing Then

cold = cell.Column

Else

Exit For

End If

Set cell = fp.Rows("2:2").Find(hr, lookat:=xlWhole)

If Not cell Is Nothing Then

colr = cell.Column

Else

colr = Cells(2, Columns.Count).End(xlToLeft).Column

End If

fp.Cells(ln, cold) = fr.Range("A" & i)

fp.Range(fp.Cells(ln, cold), fp.Cells(ln, colr)).Interior.Color = RGB(218, 150, 148)

End If

Next i

Next ln

End Sub

Rechercher des sujets similaires à "noms reservations multiples planning"