Inserer 2 lignes a chaque changement de la colonne B

Bonjour,

J'ai cette Macro qui m'insert une ligne a chaque changement de code de la colonne B

mais je souhaiterais faire évoluer cela en insérant 2 ligne au lieu de deux

Pourriez vous m'indiquer comment modifier ce code :

Sub AddBlankRows()
'
Dim iRow As Integer, iCol As Integer
Dim oRng As Range

Set oRng = Range("b1")

iRow = oRng.Row
iCol = oRng.Column

Do
'
If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
    Cells(iRow + 1, iCol).EntireRow.Insert shift:=xlDown

    iRow = iRow + 2
Else
    iRow = iRow + 1
End If
'
Loop While Not Cells(iRow, iCol).Text = ""
'
End Sub

D'avance merci du coup de main et belle journée

KissCool

Bonjour,

Si j'ai compris, tu double la commande d'insert

If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
    Cells(iRow + 1, iCol).EntireRow.Insert shift:=xlDown
    Cells(iRow + 1, iCol).EntireRow.Insert shift:=xlDown

    iRow = iRow + 2
Else

Bonjour et merci de prendre le temps de regarder

Si je double la commande, il me double uniquement la première ligne

KissCool

Bonjour Kisscool25 et le forum,
Pourriez-vous enregistrer votre fichier en xlsm puisqu'il y a une macro?

Cordialement

Ok, le fichier est enregistré

Re

Sans me casser la tête je suis passé par l'enregistreur de macromais ça fait le travail voulu

Re,

Votre macro insert uniquement sur la première ligne et non a chaque changement de numéro

;(

Re,

Sub AddBlankRows()
'
Dim iRow As Integer, iCol As Integer
Dim oRng As Range

Set oRng = Range("b1")

iRow = oRng.Row
iCol = oRng.Column

Do
'
If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
    Cells(iRow + 1, iCol).EntireRow.Insert shift:=xlDown
    Cells(iRow + 1, iCol).EntireRow.Insert shift:=xlDown
    iRow = iRow + 3
Else
    iRow = iRow + 1
End If
'
Loop While Not Cells(iRow, iCol).Text = ""
'
End Sub

Merci @M12 et au autre d'avoir regardé

tous fonctionne

Belle Journée

KissCool