Insert multiple lines into each tab

[alice9527]

Hi there,

I would like to use a macro to add multiple lines into each tab and I got this code:

Sub InsertRows()
'
'
'Insert x rows


    Worksheets("Worklist").Unprotect Password:="readpads"
    Worksheets("Tech 1").Unprotect Password:="readpads"
    Worksheets("Tech 2").Unprotect Password:="readpads"
    Worksheets("Tech 3").Unprotect Password:="readpads"
    Worksheets("Reported Results").Unprotect Password:="readpads"
    
    Dim Rws As Variant
    Rws = InputBox("How many rows")
    If Rws = "" Then Exit Sub
    
    Dim ws As Worksheet
        For Each ws In ActiveWorkbook.Sheets
    
        Rows("8:10").Select
        Selection.EntireRow.Hidden = False
        Rows("9:9").Copy
        Range("10:10").Select
        ActiveCell.EntireRow.Resize(Rws).Insert Shift:=x1Down
        Rows("9:9").Select
        Selection.EntireRow.Hidden = True
        Range("A10").Select
    
    Next ws
    
End Sub

It works fine with adding the required amount of rows, but all rows been added to the first sheets.

Could anyone please help me with this?

 

[Herakles]

It is probably because the first sheet is the active sheet and your code is working only on the active sheet.

Change the active sheet and run your code again and see what happens.

Try this slightly amended code so that the changes are made to each sheet.

I have not tested this.

Sub InsertRows()
'
'
'Insert x rows


    Worksheets("Worklist").Unprotect Password:="readpads"
    Worksheets("Tech 1").Unprotect Password:="readpads"
    Worksheets("Tech 2").Unprotect Password:="readpads"
    Worksheets("Tech 3").Unprotect Password:="readpads"
    Worksheets("Reported Results").Unprotect Password:="readpads"
    
    Dim Rws As Variant
    Rws = InputBox("How many rows")
    If Rws = "" Then Exit Sub
    
    Dim ws As Worksheet
        
        For Each ws In ActiveWorkbook.Sheets
    
        ' *** Following line added. ***
        ws.Activate
        
        Rows("8:10").Select
        Selection.EntireRow.Hidden = False
        Rows("9:9").Copy
        Range("10:10").Select
        ActiveCell.EntireRow.Resize(Rws).Insert Shift:=x1Down
        Rows("9:9").Select
        Selection.EntireRow.Hidden = True
        Range("A10").Select
    
    Next ws
    
End Sub

 

[alice9527]

That works :D
Thanks a lot !

 

[Herakles]

That works :D
Thanks a lot !

Glad to be of service. Now for some sleep.