Plusieurs combobox nom et 1 activité

Bonjour a tous

j'ais dans le fichier joint un userForm9 ou je doit choisir plusieurs nom pour une activité (combobox3) a la meme date mais soit le matin soit l’après midi .

j'ai compris pour une personne mais je n'arrive pas pour plusieurs.

auriez vous une solution ?

Merci de votre aide.

Voila j'ai ce code

Dim FeuilleDeTransfert As String
    Dim LigneDeTransfert As Byte
    Dim DebutColonneDeTransfert As Byte
    Dim FinColonneDeTransfert As Byte
    Dim A As Byte
    Dim cell As Range
    If Me.ComboBox1.ListIndex = -1 Then
'       MsgBox " Merci de documenter la période de la journée"
       Exit Sub
       ComboBox1.SetFocus
    End If

    If Me.ComboNom.ListIndex = -1 Then
        MsgBox " Le Nom doit ètre documenté"
        Exit Sub
    End If
   FeuilleDeTransfert = StrConv(Format(Datefin, "mmmm"), vbProperCase)
   Err = 0
  On Error Resume Next
  LigneDeTransfert = Application.WorksheetFunction.Match(Me.ComboNom, Worksheets(FeuilleDeTransfert).Range("C1:C100"), 0)
   If Err <> 0 Then
        Err = 0
        MsgBox "La feuille de mois ou le nom de la personne n'existe pas dans cette feuille"
        Exit Sub
   End If
   DebutColonneDeTransfert = Application.WorksheetFunction.Match(CLng(Datedeb), Worksheets(FeuilleDeTransfert).Range("D11:AI11"), 0) + 3
   If Err <> 0 Then
        Err = 0
        MsgBox "La date de début n'existe pas dans cette feuille"
        Exit Sub
   End If
   FinColonneDeTransfert = Application.WorksheetFunction.Match(CLng(Datefin), Worksheets(FeuilleDeTransfert).Range("D11:AI11"), 0) + 3
    If Err <> 0 Then
        Err = 0
        MsgBox "La date de fin n'existe pas dans cette feuille"
        Exit Sub
   End If

    If Me.ComboBox1.ListIndex = 0 Then
        A = 0
    ElseIf Me.ComboBox1.ListIndex = 1 Then
        A = 0
        LigneDeTransfert = LigneDeTransfert + 1
    ElseIf Me.ComboBox1.ListIndex = 2 Then
        A = 1
    End If

    With Sheets(FeuilleDeTransfert)
            For Each cell In Range(.Cells(LigneDeTransfert, DebutColonneDeTransfert), .Cells(LigneDeTransfert + A, FinColonneDeTransfert))
                If cell.Value = "" Then
                    cell = ComboBox3.Value
                Else
                    MsgBox (" Donnée déjà présente" & " " & "sur" & " " & Me.ComboNom)

                End If

            Next
        End With

et je l'est re-petter en changeant le nom de combobox mais je suis sur qu'il y as une solution plus simple.

        '2--------------------------------
        Dim FeuilleDeTransfert2 As String
    Dim LigneDeTransfert2 As Byte
    Dim DebutColonneDeTransfert2 As Byte
    Dim FinColonneDeTransfert2 As Byte
    Dim B As Byte
    Dim cell2 As Range
    If Me.ComboBox4.ListIndex = -1 Then
    '   MsgBox " Merci de documenter la période de la journée"
       Exit Sub
       ComboBox4.SetFocus
    End If

    If Me.ComboNom2.ListIndex = -1 Then
        MsgBox " Le Nom doit ètre documenté"
        Exit Sub
    End If
   FeuilleDeTransfert2 = StrConv(Format(Datefin, "mmmm"), vbProperCase)
   Err = 0
  On Error Resume Next
  LigneDeTransfert2 = Application.WorksheetFunction.Match(Me.ComboNom2, Worksheets(FeuilleDeTransfert2).Range("C1:C100"), 0)
   If Err <> 0 Then
        Err = 0
        MsgBox "La feuille de mois ou le nom de la personne n'existe pas dans cette feuille"
        Exit Sub
   End If
   DebutColonneDeTransfert2 = Application.WorksheetFunction.Match(CLng(Datedeb), Worksheets(FeuilleDeTransfert2).Range("D11:AI11"), 0) + 3
   If Err <> 0 Then
        Err = 0
        MsgBox "La date de début n'existe pas dans cette feuille"
        Exit Sub
   End If
   FinColonneDeTransfert2 = Application.WorksheetFunction.Match(CLng(Datefin), Worksheets(FeuilleDeTransfert2).Range("D11:AI11"), 0) + 3
    If Err <> 0 Then
        Err = 0
        MsgBox "La date de fin n'existe pas dans cette feuille"
        Exit Sub
   End If

    If Me.ComboBox4.ListIndex = 0 Then
        B = 0
    ElseIf Me.ComboBox4.ListIndex = 1 Then
        B = 0
        LigneDeTransfert2 = LigneDeTransfert2 + 1
    ElseIf Me.ComboBox4.ListIndex = 2 Then
        B = 1
    End If

    With Sheets(FeuilleDeTransfert2)
            For Each cell2 In Range(.Cells(LigneDeTransfert2, DebutColonneDeTransfert2), .Cells(LigneDeTransfert2 + B, FinColonneDeTransfert2))
                If cell2.Value = "" Then
                    cell2 = ComboBox3.Value
                Else
                     MsgBox (" Donnée déjà présente" & " " & "sur" & " " & Me.ComboNom2)

                End If

            Next
        End With

Bonsoir

Pas trop trop testé

A vérifier

super Merci banzai64