optimisation insertion de lignes en VBA

Option Explicit

Sub TheInsertor()
Dim Cell As Range, Plage As Range
Dim Start As Double
Dim Ajout As Byte
Dim nb_ligne_total As Long

Start = Timer

With Worksheets('Sheet2')
    nb_ligne_total = .Range('A65536').End(xlUp).Row
    Set Plage = .Range(.Cells(3, 1), .Cells(nb_ligne_total, 1))
    Ajout = 0
        For Each Cell In Plage
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; If .Cells(Cell.Row, 1).Value <> .Cells(Cell.Row + 1, 1).Value And Ajout = 0 Then
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; With .Cells(Cell.Row + 1, 1).EntireRow
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; .Insert
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; .Interior.ColorIndex = 0
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; .Borders.LineStyle = 0
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; End With
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Ajout = 1
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Else
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Ajout = 0
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; End If
&nbsp; &nbsp; &nbsp; &nbsp; Next
End With

MsgBox Timer - Start
End Sub

Cliquez pour agrandir...