Problème avec une insertion de lignes/tableaux

Bonjour, j'ai un soucis avec un code qui insert des tableaux correspondant à un employé dans des semaines (voir le code ci-joint). La majorité du code se situe dans le UserForm Menu_Ajout_op .

Le programme fonctionne bien pour les titulaires mais pour les tableaux des intérimaires (qui sont insérés par le bas pour réaliser un tri) le problème est le suivant : lorsque qu'on réalise un ajout d'intérimaire (à l'aide du menu "Ajout d'un opérateur") sur plusieurs semaines, si l'une d'elles contient déjà un employé mais pas une autre, alors le tableau est mal inséré comme ceci :

image

Le problème devrait se trouver dans cette partie du code :

 '----------------Insertion tableau Intérimaire-----------------------------------
                    If NbInt(tb3) = 0 Then
                        Sheets("Data").Rows("12:18").Copy
                        Sheets("IMPREGNATION").Rows(j).Insert Shift:=xlDown
                        Application.CutCopyMode = False
                        With Range(Cells(j, 3), Cells(j, 8)).Validation
                            .Delete
                            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                            xlBetween, Formula1:="=Data!$A$2:$A$10"
                        End With
                        With Range(Cells(i, 1), Cells(i, 17)).Interior
                            .Pattern = xlSolid
                            .Color = 5263615
                        End With
                        Range(Cells(j, 1), Cells(j, 2)).Interior.Color = RGB(24, 157, 204)

                        Cells(j, 1).Value = TextBox1.Text
                        Cells(j, 2).Value = TextBox2.Text
                    Else
                        Sheets("Data").Rows("12:18").Copy
                        Sheets("IMPREGNATION").Rows(j - 1).Insert Shift:=xlDown
                        Application.CutCopyMode = False
                        With Range(Cells(j - 1, 3), Cells(j - 1, 8)).Validation
                            .Delete
                            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                            xlBetween, Formula1:="=Data!$A$2:$A$10"
                        End With
                        With Range(Cells(i, 1), Cells(i, 17)).Interior
                            .Pattern = xlSolid
                            .Color = 5263615
                        End With
                        Range(Cells(j - 1, 1), Cells(j - 1, 2)).Interior.Color = RGB(24, 157, 204)

                        Cells(j - 1, 1).Value = TextBox1.Text
                        Cells(j - 1, 2).Value = TextBox2.Text
                    End If

      '--------------Test pour insertion de la ligne "sous total Int"----------------
                    If NbInt(tb3) > 0 Then
                        Sheets("Data").Rows("20").Copy
                        Sheets("IMPREGNATION").Rows(Lsem(Next_s(tb3))).Insert Shift:=xlDown
                        Application.CutCopyMode = False
                    End If

                End If
                If SousTotal(tb3, "Titulaires") = True And SousTotal(tb3, "Interimaires") = True And SousTotal(tb3, "TOTAUX") = False Then
                    Sheets("Data").Rows("24").Copy
                    Sheets("IMPREGNATION").Rows(Lsem(Next_s(tb3))).Insert Shift:=xlDown
                    Application.CutCopyMode = False
                End If

                nb_sem = nb_sem + 1
                tb3 = Convert_num_s(tb3) + 1
                tb3 = Convert_nieme_s(tb3, First_sem, Max_sem)
            End If
        i = i + 1
        j = j + 1
        If Next_s(tb3 - 1) = 0 Then
            nb_sem = TextBox4.Value + 1
        End If

        Wend

Il arrive également que la ligne "Sous total Intérimaires :" soit insérée plusieurs fois dans une semaine, ce qui ne devrait pas arriver non plus. Des idées pour palier ce problème ?

Rechercher des sujets similaires à "probleme insertion lignes tableaux"