Réalisé une macro en fonction du nom

'On formate le nom
Nom_bis = Mid(Nom, 3, Len(Nom))

'On parcourt tous les noms
    For NoLig = 1 To FCible.UsedRange.Rows.Count
        Var = FCible.Cells(NoLig, NoCol)
'Si le nom correspond à un membre de l'équipe alors on copie la ligne
       If Var Like ("* " & Nom_bis) Then
        FCible.Rows(NoLig).Copy Destination:=FCible_bis.Cells(num_ligne, 1)
        num_ligne = num_ligne + 1
        End If
    Next
'On passe à la personne suivante
b = b + 1
num_ligne = num_ligne + 1
Next Membre
 

Option Explicit
 
Sub Imputation()
 
'Declaration des variables
 
Dim celluletrouvee As Range
Dim Cell As Range, Cellnom As Range
Dim Plage As Range, Plage_nom As Range
Dim Membre As Range

 
Dim FSource As Worksheet
Dim FCible As Worksheet
Dim FCible_bis As Worksheet
 
Dim Un As Collection


Dim ssdoublon()

Dim Section As String
Dim Nom As String
Dim Description As String
Dim Nom_bis As String
Dim Tampon As Long

Dim dl As Long, dl_bis As Long
Dim Heure As Long
Dim Dec As Long
Dim Sum As Long
Dim Colonne As Long
Dim b As Long
Dim i As Long, n_ligne As Long, a As Long
Dim num_ligne As Long

Dim Condition As Integer
Dim NoLig As Long, Var As Variant
Dim NoCol As Integer

 
'On récupère les valeurs données par l'opérateur
'Feuille Source
Set FSource = Worksheets("Cmd")
Section = FSource.Range("B2").Value
    
'Pour eviter les alertes
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With

'On récupère le nom de la section
Sheets.Add Worksheets(1)
'On crée la feuille tampon
Sheets(1).Name = "tampon"
Set FCible_bis = Worksheets("tampon")

'On récupère la liste des membres
Set FCible = Worksheets("Ar_plan")

'On va parcourir la liste des sections
Set celluletrouvee = FCible.Range("A2:Z2").Find(Section, LookAt:=xlWhole)

'On envoie un message d'erreur si on trouve rien
If celluletrouvee Is Nothing Then
MsgBox ("Pas trouvé de section")
Else
'Sinon on se concentre sur cette colonne
Colonne = celluletrouvee.Column
End If

'On va introduire nos conditions(pour la suite)
Condition = 0
If Section = "Un" Then Condition = 1
If Section = "Deux" Then Condition = 2


'On va parcourir la liste des membres
b = 0
num_ligne = 1

Set Plage = FCible.Range(celluletrouvee, celluletrouvee.End(xlDown)).Rows
For Each Membre In Plage
   Nom = Membre.Value
   'MsgBox (Membre.Value)
   
'On formate le nom
Nom_bis = Mid(Nom, 3, Len(Nom))
   

'On va prendre uniquement les membres de la section
'Feuille Cible
    Set FCible = Worksheets("DATA")
'On initalise
NoCol = 1 'lecture de la colonne 1

'On parcourt tous les noms
    For NoLig = 1 To FCible.UsedRange.Rows.Count
        Var = FCible.Cells(NoLig, NoCol)
'Si le nom correspond à un membre de l'équipe alors on copie la ligne
       If Var Like ("* " & Nom_bis) Then
        FCible.Rows(NoLig).Copy Destination:=FCible_bis.Cells(num_ligne, 1)
        num_ligne = num_ligne + 1
        End If
    Next
'On passe à la personne suivante
b = b + 1
num_ligne = num_ligne + 1
Next Membre
 
 
    
'On va étudier les études de la section
Set FCible = Worksheets("tampon")

'On efface les données précédentes
FSource.Range("E:J").Clear

'On associe les valeurs à nos colonnes
FSource.Cells(1, 5) = "NOM OTP"
FSource.Cells(1, 6) = "Description"
FSource.Cells(1, 7) = "Heure d'étude"
FSource.Cells(1, 8) = "Pondération"
FSource.Cells(1, 9) = "Heure à imputer"
FSource.Cells(1, 10) = "Arrondi"

'On cherche la dernière ligne
With ActiveSheet
   dl = FCible.Range("D" & .Rows.Count).End(xlUp).Row
End With
'On défini la nouvelle plage
Set Plage = FCible.Range("D1:D" & dl)
Set Un = New Collection
On Error Resume Next
 
'On parcourt la plage de donnée
'On réalise le liste des études sans doublon
For Each Cell In Plage
   If Cell <> "" And Not IsEmpty(Cell) Then Un.Add Cell, CStr(Cell) 'Si la valeur est différent des autres on la prends sinon on passe
Next Cell
    
For i = 0 To Un.Count
   ReDim Preserve ssdoublon(i)
   ssdoublon(i) = Un.Item(i)
  Next i
  
Heure = 0 'on inialise

For i = 0 To UBound(ssdoublon)
If ssdoublon(i) Like "*.*" Then
  ' à la place remplis ta listbox
  'On ecrit le projet sur notre ligne de sortie
n_ligne = 1

FCible_bis.Cells(n_ligne + i, 10) = ssdoublon(i)

Sum = 0 'on initalise
For Each Cell In Plage
If Cell = ssdoublon(i) Then Sum = Sum + Cell.Offset(0, 2).Value
'Si le projet est le bon on récupère son heure
If Cell = ssdoublon(i) Then Description = Cell.Offset(0, 1).Value
Next Cell


'On écrit la somme des heures travaillées sur un projet
FCible_bis.Cells(n_ligne + i, 11) = Description

FCible_bis.Cells(n_ligne + i, 12) = Sum
End If
 Next i
 
 
 'On va trier ce tableau

    FCible_bis.Range("J:L").Select
    Selection.Sort Key1:=Range("L2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        

b = 2
Heure = 0

For NoLig = 1 To FCible_bis.Range("J1").End(xlDown).Row
If Condition = 2 Then
If Not FCible_bis.Cells(NoLig, 10) Like "F.*" Then
FCible_bis.Cells(NoLig, 10).Copy Destination:=FSource.Cells(b, 5)
FCible_bis.Cells(NoLig, 11).Copy Destination:=FSource.Cells(b, 6)
FCible_bis.Cells(NoLig, 12).Copy Destination:=FSource.Cells(b, 7)
Heure = Heure + FCible_bis.Cells(NoLig, 12).Value
b = b + 1
End If
End If

If Condition < 2 Then
FCible_bis.Cells(NoLig, 10).Copy Destination:=FSource.Cells(b, 5)
FCible_bis.Cells(NoLig, 11).Copy Destination:=FSource.Cells(b, 6)
FCible_bis.Cells(NoLig, 12).Copy Destination:=FSource.Cells(b, 7)
Heure = Heure + FCible_bis.Cells(NoLig, 12).Value
b = b + 1
End If
Next NoLig



For a = 0 To i - 1

'On caclule les pourcentages et on l'écrit
FSource.Cells(n_ligne + a, 8) = FSource.Cells(n_ligne + a, 7) / Heure

'On calcule le nombre d'heure à impuer et on l'écrit
FSource.Cells(n_ligne + a, 9) = FSource.Cells(n_ligne + a, 8) * FSource.Cells(2, 3)

'On va arrondir les valeurs
FSource.Cells(n_ligne + a, 10) = Round(FSource.Cells(n_ligne + a, 9))
Next a


If Condition > 0 Then
'Condition pour alpha et beta
    For NoLig = 0 To FSource.Range("J1").End(xlDown).Row
        If FSource.Cells(NoLig, 10).Value = 0 Then
        FSource.Cells(NoLig, 10) = ""
        FSource.Cells(NoLig, 9) = ""
        FSource.Cells(NoLig, 8) = ""
        FSource.Cells(NoLig, 7) = ""
        FSource.Cells(NoLig, 6) = ""
        FSource.Cells(NoLig, 5) = ""
        End If
      Next NoLig
  End If

Sum = 0
Heure = 0

'On va calculer les sommes
For a = 1 To FSource.Range("E1").End(xlDown).Row - 1
Sum = Sum + FSource.Cells(n_ligne + a, 7)
Heure = Heure + FSource.Cells(n_ligne + a, 10)
Next a


'On les écrit
FSource.Cells(a + 1, 7) = Sum
FSource.Cells(a + 1, 10) = Heure
FSource.Cells(a + 1, 5) = "Total"


Set Un = Nothing
 Sheets("tampon").Delete
Application.ScreenUpdating = True

End Sub