Auto Insert Rows

D

Dominique Feteau

I need a macro that will insert 3 blank rows between each row i already have
filled. For example:

From:

Customer1
Customer 2
Customer 3

To:
Customer 1


Customer 2


Customer 3

Any help would be appreciated.

Dominique
 
F

Frank Kabel

Hi
try the following macro. It tests column A and inserts a blank row if
the values change
Sub insert_rows()
Dim lastrow As Long
Dim row_index As Long

lastrow = ActiveSheet.Cells(Rows.count, "A").End(xlUp).row
For row_index = lastrow - 1 To 1 Step -1
If Cells(row_index, "A").Value <> Cells(row_index + 1, "A").Value
Then
Cells(row_index + 1, "A").resize(3,1).EntireRow.Insert
(xlShiftDown)
End If
Next
End Sub
 
T

Trevor Shuttleworth

Dominique

assuming you have a header in row 1, try this:

Sub InsertBlankRows()
Dim LastRow As Long
Dim i As Long
Application.ScreenUpdating = False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = LastRow - 1 To 2 Step -1
Range("A" & i).Offset(1, 0).Resize(3, 1).EntireRow.Insert
Next 'i
Application.ScreenUpdating = True
End Sub

Regards

Trevor
 
Top