Try:
Sub AddThree()
Dim Last As Long
Dim x As Long

Application.ScreenUpdating = False
Last = Cells(Rows.Count, 1).End(xlUp).Row

For x = Last To 3 Step -1
If Cells(x, 1).Value = Cells(x - 1, 1).Value Then
GoTo Again
End If

Cells(x, 1).Resize(3, 1).Insert Shift:=xlDown
Again:
Next x

Application.ScreenUpdating = True


End Sub



--
HTH

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings


Replace @mailinator.com with @tiscali.co.uk


"WRC" wrote in message
...
NEED TO ADD THE FOLLOWING. 3 ROWS SEPERATE THEM & ANY NUMBER OF ROWS CAN
BE
ADDED:

1
1
1
1
1
1
3 ROWS BLANK
2
2
2
2
2
2
3 ROWS BLANK
3
3
3
3
3
3

THANKS
raj