Tenho uma planilha com 10k linhas, nesse formato (exemplo):
3004977 \{DOWN} \{TAB 9} REMESSAS \%S 18082017 \{TAB} 2 \%D \^ S
3004972 \{DOWN} \{TAB 9} REMESSAS \%S 18082017 \{TAB} 3 \%D
3004972 \{DOWN} \{TAB 9} REMESSAS \%S 18082017 \{TAB} 2 \%D
3004972 \{DOWN} \{TAB 9} REMESSAS \%S 18082017 \{TAB} 2 \%D
3004972 \{DOWN} \{TAB 9} REMESSAS \%S 18082017 \{TAB} 2 \%D
3004972 \{DOWN} \{TAB 9} REMESSAS \%S 18082017 \{TAB} 1 \%D \^ S
3004967 \{DOWN} \{TAB 9} REMESSAS \%S 18082017 \{TAB} 110 \%D \^ S
A cada mudança na coluna A existe uma linha em branco. Mas preciso inserir mais 3, em todas. Com o código abaixo, que achei no SOen, ele só adiciona na primeira:
Sub AddBlankRows()
'
Dim iRow As Integer, iCol As Integer
Dim oRng As Range
Set oRng = Range("a1")
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
Alguma sugestão?