Bonsoir IceTea et Jean-Marie,
En complément de la réponse de Jean-Marie, vous trouverez une variante (programmée) de la solution au problème créant dynamiquement les plannings de chaque entreprise dans des feuilles distinctes, autorisant un ajout d'entreprise et de chantiers sans modification de la programmation, et contrôlant la saisie des informations (références).
=====================================================
Private Sub CommandButton1_Click()
'Paramètres à régler (Zones apparaissant en gris dans les feuilles)
Set RngTabEnt = Sheets("Entreprises").Range("A53:A100") 'Tableau Entreprises
Set RngTabCht = Sheets("Chantiers").Range("B53:G100") 'Tableau Chantiers
Set RngTabPlg = Sheets("Plannings").Range("B53:L100") 'Tableau Planning Général
Application.ScreenUpdating = False 'Désactivation rafraîchissement Ecran
'Suppression des anciens plannings
Application.DisplayAlerts = False
For Each Sht In Worksheets
If Left(Sht.Name, 2) = "P." Then Sht.Delete
Next Sht
Application.DisplayAlerts = True
'Pour chaque entreprise valorisée dans le tableau des entreprises
For Each Ent In RngTabEnt
If Ent <> "" Then
'Création d'une feuille planning (onglet bleu)
Set Sht = Worksheets.Add(after:=Worksheets(Worksheets.Count))
Sht.Name = "P." & Ent
Sht.Tab.ColorIndex = 5
'Initialisation de la feuille à partir du planning général
Worksheets("Plannings").Cells.Copy Destination:=Sht.Cells
Sht.Range("A51").VerticalAlignment = xlCenter
Sht.Range("B51") = Sht.Range("B51") & " - " & Ent
Sht.Range(RngTabPlg.Address).ClearContents
End If
Next Ent
Sheets("Plannings").Activate
'Pour chaque travail valorisé dans le tableau Planning Général
For Each PlgTrv In RngTabPlg.Cells
If PlgTrv <> "" Then
'Recherche dans le tableau de l'entreprise à qui ce travail a été affecté
For Each Cel In RngTabCht
If Cel <> "" And _
Sheets("Chantiers").Cells(RngTabCht.Rows(1).Offset(-1, 0).Row, Cel.Column) = _
PlgTrv And _
Sheets("Chantiers").Cells(Cel.Row, RngTabCht.Columns(1).Offset(0, -1).Column) = _
Sht.Cells(PlgTrv.Row, RngTabPlg.Columns(1).Column - 1) Then
'Quand trouvé, ventilation du travail dans le Planning spécifique Entreprise
Sheets("P." & Cel).Cells(PlgTrv.Row, PlgTrv.Column) = PlgTrv
Exit For
End If
Next Cel
End If
Next PlgTrv
Application.ScreenUpdating = True 'Réactivation rafraîchissement Ecran
End Sub
=====================================================
En vous souhaitant bon week-end.
Omicron.