Inserting rows on multiple worksheets

pcrowley

Board Regular
Joined
Dec 12, 2011
Messages
118
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.
 
I have modified the code to include a request you made earlier, that I missed (go back to row that was first inserted) and also added lines to allow each worksheet to have different levels of protection .
Rich (BB code):
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
    Dim sWorksheet As String
    Dim lFirstRowSelected As Long
    
    arySheets = Array("Task Analysis", "Assessment")
    Application.ScreenUpdating = False
    sWorksheet = Selection.Worksheet.Name
    lFirstRowSelected = Selection(1).Row
    
    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
    Next
End_Sub:

    Worksheets("Task Analysis").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Worksheets("Assessment").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Application.Goto Worksheets(sWorksheet).Cells(lFirstRowSelected, 1), Scroll:=True
    Application.ScreenUpdating = True
    
End Sub
I don't know of a way allow a user to change the contents of a cell without also allowing the use to change the formatting. An alternate method would be to write code to apply the desired conditional formatting to each worksheet each time the workbook is opened.

The best way to figure out what code Excel likes is to turn on the macro recorder and perform the actions that you want to automate. For instance, in Excel 2007 if I select all of the options for protecting a worksheet, the following code is generated:

Rich (BB code):
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True

While the recorded code will run correctly if all of the conditions that existed when it was recorded are replicated, often it is necessary to modify the code to do what you really want. In this case, replacing the object that is being acted on ActiveSheet with a specific worksheet Worksheets("Sheet3").

This site is great for helping you to optimize the recorded code and to learn how to use VBA to make your Excel workbooks more useful.

Excel 2007/2010 does not do a good job of recording code when working with graphic objects or charts. Excel 2003 is better for that.
 
Upvote 0

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

Forum statistics

Threads
1,213,550
Messages
6,114,265
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top