Find text and insert nth blank rows above until text is on row 20

[Andy15]

Hi Guys,

I am looking for a bit of help to move some data down to a specific row across multiple worksheets.

I have the text "Name" in column B, the text "Name" could be on any row from 1 to 15. There will only be 1 occurrence of the text per worksheet.

I would like to insert blank rows above the text "Name" as many rows as necessary to make the text "Name" be on row 20

I would then like to move on to the next worksheet until all worksheets have been done.

Many thanks for any help
Andy15

 

[tonyyy]

Andy15,

You might consider the following

Sub InsertRows()
Dim ws As Worksheet
Dim found As Long

For Each ws In ThisWorkbook.Worksheets
    found = ws.Columns(2).Find(What:="Name", After:=ws.Cells(1, 2), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Row
    ws.Rows(found & ":" & found + (19 - found)).Insert
Next ws
MsgBox "Done!"
End Sub

Cheers,

tonyyy

 

[Andy15]

Hi tonyyy,

Thanks for the code. It works as requested which is great, however my mistake but I forgot to add that new worksheets are added regularly and I need to run the code every week. What is happening is when the macro is run again the sheets that have already been adjusted are moved down by another 2 rows. Is there a way to say if the text "Name is on row 20 do nothing.

Cheers
Andy15

 

[tonyyy]

Sub InsertRows()
Dim ws As Worksheet
Dim found As Long

For Each ws In ThisWorkbook.Worksheets
    found = ws.Columns(2).Find(What:="Name", After:=ws.Cells(1, 2), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Row
    [COLOR=#ff0000]If found < 20 Then [/COLOR]ws.Rows(found & ":" & found + (19 - found)).Insert
Next ws
MsgBox "Done!"
End Sub

 

[Andy15]

Many thanks tonyyy,

Works a treat.

 

[tonyyy]

You're welcome, Andy15. Glad it worked out...