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
26
27
28
29
30
31
32
33
34
35
36
37
38
39
| Sub Insérer_Lignes()
Dim Lg As Long, i As Long, DerLig_Total As Range
Application.ScreenUpdating = False
Lg = Range("A" & Rows.Count).End(xlUp).Row
Set DerLig_Total = Columns("C").Find("Total", lookat:=xlWhole)
If Not DerLig_Total Is Nothing Then
MsgBox "Les totaux ont déjà été traités"
Exit Sub
End If
Cells(Lg + 1, "C") = "Total"
For i = Lg To 2 Step -1
If Range("c" & i - 1) <> Range("c" & i) Then
Rows(i).EntireRow.Insert
Range(Cells(i, "A"), Cells(i, "F")).Interior.Color = RGB(225, 225, 225)
Set DerLig_Total = Columns("C").Find("Total", lookat:=xlWhole)
If Not DerLig_Total Is Nothing And DerLig_Total.Row > i Then
Range(Cells(i, "D"), Cells(i, "F")).FormulaR1C1 = "=SUM(R" & i + 1 & "C:R" & DerLig_Total.Row - 1 & "C)"
Cells(i, "C") = "Total"
With Range(Cells(i, "A"), Cells(i, "F")).Font
.Bold = True
.Size = 20
End With
Rows(i).RowHeight = 42.75
End If
End If
Next i
Range("C" & Rows.Count).End(xlUp).ClearContents
Set DerLig_Total = Nothing
End Sub
Sub Supprimer_Totaux()
Dim DerLig As Long, i As Long
Application.ScreenUpdating = False
DerLig = Range("A" & Rows.Count).End(xlUp).Row
For i = DerLig To 2 Step -1
If Cells(i, "C") = "Total" Then Rows(i).Delete
Next i
End Sub |
