1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
| Sub Mise_en_forme()
Dim DerLig As Long, N As Long, I As Long, Total As Long
Application.ScreenUpdating = False
'recopie du tableau dans la partie droite
DerLig = [E1].End(xlDown).Row
Range("A2:F" & DerLig).Copy Destination:=Range("I2:N" & DerLig)
'Mise en forme
For I = 2 To DerLig
If Cells(I, "J") <> Cells(I, "L") Then
Total = Cells(I, "L")
N = I
Do While Total < Cells(I, "J")
Total = Total + Cells(N, "L")
Range(Cells(N + 1, "J"), Cells(N + 1, "K")).Insert Shift:=xlDown
N = N + 1
Loop
End If
Next I
'Quadrillage
Range("I2:N1000").Borders().LineStyle = xlNone
Range("I2:N" & DerLig).Borders().Weight = xlThin
End Sub |
Partager