Private Sub CommandButton1_Click()
Dim LstCol&, i&, LstColTab&, FrstLig&, z&, c&, a&, k&, b&
Dim Plg, Dico, TabLig, Multi As Variant
Application.ScreenUpdating = False
Columns("K:S").ClearContents
LstCol = ActiveSheet.UsedRange.Columns.Count
Plg = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, LstCol)).Value
Set Dico = CreateObject("Scripting.Dictionary")
For i = LBound(Plg, 1) To UBound(Plg, 1)
If Plg(i, 1) = "" Then Dico(i) = i
Next i
TabLig = Dico.Keys
For a = LBound(TabLig) To UBound(TabLig) - 1
LstColTab = 0
FrstLig = TabLig(a)
z = 0: Multi = Plg(FrstLig + 3, 2)
For c = 1 To LstCol
If Plg(FrstLig + 5, c) <> "" Then LstColTab = LstColTab + 1
Next c
For k = 2 To LstColTab Step 2
z = z + 1
Plg(FrstLig + 5, k) = "Unite " & LstColTab + z
For b = 1 To (TabLig(a + 1) - FrstLig) - 6
Plg(FrstLig + 5 + b, k) = Plg(FrstLig + 5 + b, k) / Multi
Next b
Next k
Next a
Cells(1, 11).Resize(UBound(Plg, 1), UBound(Plg, 2)) = Plg
Application.ScreenUpdating = True
End Sub