Add Blank Row Excel Using VBA

Question

Add Blank Row Excel Using VBA

Navigation

#1 by (1 votes)

1

I have a spreadsheet with 10k lines, in this format (example):

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

Each change in column A has a blank line. But I need to insert 3 more, in all. With the code below, which I found in SOen, it only adds at first:

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

Any suggestions?

vba

asked by anonymous 18.08.2017 / 21:36

1 answer

Laravel: how to recover the primary key of a model after saving it [closed] Join of two tables query php + mysql

score 1 · Accepted Answer

See if it caters to you this way:

Sub AdicionaLinhaBranco()

Dim COLUNA_VERIFICAR As String
Dim ULTIMA_LINHA As Integer
Dim QTD_LINHAS As Integer
Dim i As Integer

Application.ScreenUpdating = False

COLUNA_VERIFICAR = "A"
QTD_LINHAS = 2
ULTIMA_LINHA =     ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row

Range(COLUNA_VERIFICAR & "1").Select

Do While ActiveCell.Row < ULTIMA_LINHA

    If ActiveCell.Offset(1).Value <> "" Then
        ActiveCell.Offset(1).Select
    Else
        ActiveCell.Offset(1).Select
        For i = 1 To QTD_LINHAS
            ActiveCell.EntireRow.Insert Shift:=xlDown
        Next i
        ActiveCell.Offset(QTD_LINHAS + 1).Select
        ULTIMA_LINHA = ULTIMA_LINHA + QTD_LINHAS
    End If
Loop

End Sub

Good luck and success!