Plan de charge bureau études

Salut,

Je suis entrain d'essayer de créer un plan de charge pour un bureau d'études.

Actuellement nous utilisons déjà un fichier excel.

Le problème est que les intervenants peuvent se retrouver dans plusieurs affaires et que le fichier est classé par intervenants donc pour un même projet il faut modifier plusieurs lignes très distante chacune ... Bref c'est pas pratique ...

L'idée du fichier que je joins est de classer par affaire, avec la liste des intervenants dessous.

De cette manière, un chef de projet mets à jour chaque affaire sans chercher dans le fichier pendant des heures.

Et ensuite, il faudrait que les lignes du début (entre 3 et 8, mais potentiellement extensible si des intervenants se rajoutent) se mettent à jour en faisant la somme de chaque colonne suivant le tryptique indiqué dans la B...

Dites moi si je ne suis pas clair !

Bonjour PatICI,

Je te propose de créer 2 plages nommées pour "Tableau_Projets" et "Tableau-Intervenant" et d'ajouter le code suivant :

Option Explicit
Sub RecalcProjets()
    Dim oTableauProjets As Range
    Dim oRowProjet As Range

    Set oTableauProjets = ThisWorkbook.Names("Tableau_Projets").RefersToRange

    For Each oRowProjet In oTableauProjets.Rows
        'Si le code projet n'est pas vide, on lance le calcul
        If Len(oRowProjet.Cells(1, 2)) > 0 Then
            TotalisationProjet oRowProjet
        End If
    Next
End Sub
Sub TotalisationProjet(zProjet As Range)
    Dim oTableau As Range, oColumn As Range
    Dim lCol As Long, lRow As Long
    Dim sCodeProjet As String, dblTotal As Double

    'On récupère le code projet
    sCodeProjet = zProjet.Cells(1, 2).Value

     'On efface les filtres actuels au cas où...
     On Error Resume Next
     ActiveSheet.ShowAllData
     On Error GoTo 0

     'On filtre le tableau_Intervenants sur le code projet
     Set oTableau = ThisWorkbook.Names("Tableau_Intervenants").RefersToRange

     oTableau.AutoFilter Field:=2, Criteria1:=sCodeProjet

     For Each oColumn In oTableau.Columns
         lCol = oColumn.Column
         'Si l'entête de colonne est une semaine on fait le calcul
         Dim o As Range
         Set o = zProjet.Offset(2 - zProjet.Row)
         If Left(zProjet.Offset(2 - zProjet.Row).Cells(1, lCol).Value, 1) = "S" And IsNumeric(Mid(zProjet.Offset(2 - zProjet.Row).Cells(1, lCol).Value, 2)) Then
             'On récupère le total
             dblTotal = Application.WorksheetFunction.Subtotal(9, oTableau.Columns(lCol).SpecialCells(xlCellTypeVisible))
             'On renseigne le tableau Projet
             zProjet.Cells(1, lCol).Value = dblTotal
             'TotalisationProjet = oLO.TotalsRowRange.Columns(zProjet.Column).Value
         End If
         'On efface les filtres actuels au cas où...
     Next
     On Error Resume Next
     ActiveSheet.ShowAllData
     On Error GoTo 0
     'On fait le ménage
     'Set oLO = Nothing

End Sub

Je joins mon EXCEL de test.