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 :
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
WendIl 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 ?