Inserting rows on multiple worksheets

[pcrowley]

I have a workbook with 8 or 10 sheets. I would like to have a macro run by clicking on a button from any one of three specific sheets (i.e. Sheet 1, Sheet 3, and Sheet 8). The macro would copy and paste the selected row as a new row immediately above (or below whichever is easier to write in the macro) the selected row into the sheet. The same operation needs to happen in the same location on the other two sheets copying and pasting the corresponding row on the other sheet to the same location on the other sheets. All the rows that would be copied have functionality that needs to be maintained in the new row. This functionality varies by sheet.

In other words, if I click on row 5 in sheet 1, and run the macro I would like to insert a copy of row 5 immediately above (or below) row 5 with all functionality included. Row 5 on the other two sheets would also need to be copied and pasted to the corresponding location on their respective sheets.

A related question is, can I protect the sheet so that rows can’t be inserted, or copied and pasted except by using the macro.

As usual, thank you all for your help.

 

[pbornemeier]

Test this code on a copy of your workbook:

Option Explicit

Sub InsertSelectedRow()
    
    Dim arySheets As Variant
    Dim lSelectedRow As Long
    Dim lX As Long
    
    If Selection.Rows.Count > 1 Then
        MsgBox "More than one row selected.  Exiting."
        GoTo End_Sub
    End If
    
    arySheets = Array("Sheet1", "Sheet3", "Sheet8")
    lSelectedRow = Selection.Row
    
    For lX = LBound(arySheets) To UBound(arySheets)
        With Worksheets(arySheets(lX))
            .Select
            .Unprotect
            .Rows(lSelectedRow).Select
            Selection.Copy
            Selection.Insert Shift:=xlDown
            
            .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        End With
    Next
    
End_Sub:

End Sub

 

[pcrowley]

Thank you for the respons, I'll give it a try.

 

[pcrowley]

In July you provided me with the macro below which did exactly what I asked for - Thank you!

I haved been asked modify the macro so multiple rows can be copied and inserted. I tried deleting the lines that check if more than one row is selected, but that didn't seem to work properly. Is that possible? If it is, do the selected rows need to be in a continous block, or can multiple rows be selected using control/select? Also, is there a way to return the focus to the first row selected when the macro finishes?

Thank you again for your help.

Test this code on a copy of your workbook:

Option Explicit

Sub InsertSelectedRow()
    
    Dim arySheets As Variant
    Dim lSelectedRow As Long
    Dim lX As Long
    
    If Selection.Rows.Count > 1 Then
        MsgBox "More than one row selected.  Exiting."
        GoTo End_Sub
    End If
    
    arySheets = Array("Sheet1", "Sheet3", "Sheet8")
    lSelectedRow = Selection.Row
    
    For lX = LBound(arySheets) To UBound(arySheets)
        With Worksheets(arySheets(lX))
            .Select
            .Unprotect
            .Rows(lSelectedRow).Select
            Selection.Copy
            Selection.Insert Shift:=xlDown
            
            .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        End With
    Next
    
End_Sub:

End Sub

 

[pbornemeier]

So if you select row 5,6,7 do you want 5,5,6,6,7,7 or 5,6,7,5,6,7?
Is there any chance you would select 6,18,43?

 

[pcrowley]

I am thinking that the 5,5,6,6,7,7 option would be best, and selecting such as the 6,18,43 would be really cool. Also, right now the existing macro seems to take me back to the beginning of Sheet1 wafter running. Is it possible to return the focus to the first row selected?


Thank you so much for your help, it is really apprecated.

 

[pbornemeier]

Try this:

Option Explicit

Sub InsertSelectedRows()
    
    Dim arySheets As Variant
    Dim lSelectedRow As Long
    Dim lX As Long, lY As Long, lSelRows As Long
    Dim rngSelected As Range
    Dim rngRow As Range
    Dim lSelectedRows() As Long
    Dim lFirst As Long
    Dim lLast As Long
    Dim lTemp As Long
    
    arySheets = Array("Sheet1", "Sheet3", "Sheet8")
    Application.ScreenUpdating = False
    
    For lX = 1 To Selection.Areas.Count
        For lY = 1 To Selection.Areas(lX).Rows.Count
            lSelRows = lSelRows + 1
            ReDim Preserve lSelectedRows(1 To lSelRows)
            lSelectedRows(lSelRows) = CLng(Selection.Areas(lX).Rows(lY).Row)
        Next lY
    Next lX
    
    'Sort
    lFirst = LBound(lSelectedRows)
    lLast = UBound(lSelectedRows)
    For lX = lFirst To lLast - 1
        For lY = lX + 1 To lLast
            If lSelectedRows(lX) > lSelectedRows(lY) Then
                lTemp = lSelectedRows(lY)
                lSelectedRows(lY) = lSelectedRows(lX)
                lSelectedRows(lX) = lTemp
            End If
        Next lY
    Next lX
    
    For lY = LBound(arySheets) To UBound(arySheets)
        With Worksheets(arySheets(lY))
            .Select
            .Unprotect
            For lX = UBound(lSelectedRows) To 1 Step -1
                .Rows(lSelectedRows(lX)).Select
                Selection.Copy
                Selection.Insert Shift:=xlDown
            Next
        End With
        '.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Next
End_Sub:
    Application.ScreenUpdating = True
    
End Sub

 

[pcrowley]

Perfect, thank you very much!

 

[pbornemeier]

You're welcome. I forgot to uncomment the line that begins with .Protect. Uncomment it if you want the worksheets to be protected after the insertions are performed.

 

[pcrowley]

Yes, I noticed that (I'm starting to understand the code). When I first tried it, I got an error message so I moved the protect statment outside the for/next loop and it seems to work fine. Thanks.

I'm a little fuzzy on the parameters for protecting the sheets. I have modifed your macro so that it works on two sheets, "Task Analysis" and "Assessment" On the Task Analysis sheet I don't want them to be able to insert or delete rows outside of the macro, or change the formatting (mostly conditional formatting) of the cells. They should be able to select a row and delete the cell values without having to unprotect the sheet. Other than conditional formatting, there is no functionality in these cells.

On the Assessment sheet there is a lot of functionality in the cells. I don't want them to be able to insert or delete rows outside of the macro, or change the formatting. I have locked some cells whose values carry over from the Task Analysis sheet and that seems to work fine.

How do I set different protection parameters for each sheet? I tried adding the sheet name in front of the protection statement.:

For example "Task Analysis".Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

I kept getting an error, so I'm not sure I have the syntax correct.

Thank you so much for your patience and all your help. You are making me look good to my boss, although I am giving you and the forum all the credit.