Problème plusieurs plages sur planning VBA

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 prendre plusieurs véhicules :

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

Si une âme charitable se propose de m'aider

Merci pour votre aide

Le code c-dessous fonctionne très bien pour une colonne dans "réservation" mais pour plusieurs... je n'y arrive pas..

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

Ca y est !

J'ai trouvé, je met le code pour ceux que ça intéresse !

Merci à ceux qui m'ont aidé

- Ne jamais désespérer mais persévérer ! -

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" & Rows.Count).End(xlUp).Row

If fp.Range("A" & ln) = fr.Range("E" & 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

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

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

If fp.Range("A" & ln) = fr.Range("F" & 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

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

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

If fp.Range("A" & ln) = fr.Range("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 à "probleme plages planning vba"