Rajouter des lignes

Sub ajout_ligne()
Dim C As Range
For Each C In Range("a1:a6000")
If C Like "CC" Then Rows(C.Row + 1).Insert
Next
End Sub

Sub Bouton1_Clic()
Application.ScreenUpdating = False
Dim derligne
derligne = Range("A65535").End(xlUp).Row
For i = derligne To 2 Step -1
If Cells(i - 1, 1).Value = "CC" Then
    Rows(i).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Cells(i, 1).Value = "CC"
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Cells(i, 1).Value = "CC"
End If
Next i
[A1].Select
Application.ScreenUpdating = True
End Sub

Sub Bouton1_Clic()
Application.ScreenUpdating = False
Dim derligne
derligne = Range("A65535").End(xlUp).Row
For i = derligne To 2 Step -1
If Cells(i - 1, 1).Value = "CC" Then
    Rows(i).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Cells(i, 1).Value = "CC"
    Cells(i, 2).Value = Cells(i - 1, 2).Value
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Cells(i, 1).Value = "CC"
    Cells(i, 2).Value = Cells(i - 1, 2).Value
End If
Next i
[A1].Select
Application.ScreenUpdating = True
End Sub