Sub Add_rows()
Dim sh as Worksheet, Irow as Long
Dim rng as Range
Application.ScreenUpdating = False
'will put 3 row between rows
for each sh in activeworkbook.Worksheets
sh.Activate
Irow = Range("A65536").End(xlUp).Row

Do Until Irow = 4
Set Rng = Range("A" & Irow)
Rng.Resize(3, 1).EntireRow.Insert
Irow = Irow - 1
Loop
Next sh
Application.ScreenUpdating = True
End Sub

--
Regards,
Tom Ogilvy

" wrote:

Hello,

I found this code when researching to add rows to a worksheet. Could
someone help me modify it so that when I'm running the code to add rows
to multiple worksheets in a workbook that does not have but 3 rows
bucause this code will not work if the worksheet does not have at least
4 rows of text?

I have 75 worksheets in my workbook but some of the worksheets have
only 3 rows of text and the below code will stop working. How can the
code be changed so that if there is no text in the 4 row the code will
know to move to the next worksheet in the workbook?

Sub Add_rows()
'will put 3 row between rows
Irow = Range("A65536").End(xlUp).Row
Application.ScreenUpdating = False
Do Until Irow = 4
Set Rng = Range("A" & Irow)
Rng.Resize(3, 1).EntireRow.Insert
Irow = Irow - 1
Loop
Application.ScreenUpdating = True
End Sub

Thank you for your help in advance,
jfcby