Run a macro for all sheets to insert a row and copy formula from above cells

Question

I search a macro that is if inserted a new row, then Column A cell of that new row will fill-down above cell formula which deals with auto numbering. The formula is:

=IF(TRIM(B3)<>"",COUNTA($B$3:B3)&".","")

In Column B, I have names of 300 Staff of my organization with one row interval to differentiate between States. If a new staff join our organization, I need to insert a row within his/her State. And I use a macro below to work it.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = ActiveCell.Column Then
        refRow = Target.Row - 1
        thisRow = Target.Row
        Range("A" & refRow & ":A" & refRow).Copy Range("A" & thisRow & ":A" & thisRow)
    End If
End Sub

It works fine in Sheet1. Here is my problem:

In Column A and B of Sheet2 and Sheet3, I link rows with Sheet 1's Column A and B, by using simple:

=Sheet1!A3
=Sheet1!B3

These two columns of all sheets are the same, starting at row 3 of all sheets. I want an event that if I insert a new row in Sheet1, then it will insert a new row of same position into Sheet2 and Sheet3. Then copy relative formula from the above cells in Sheet2 and Sheet3. I have got the above macro for Sheet1, but can't apply to all Sheets. I tried to copy that macro into Sheet2 and Sheet3, but it doesn't work. How could I make it work?

izzymo izzymo · Accepted Answer · 2015-03-30T11:28:40

This should do the trick... Obviously I'm assuming your sheet names are Sheet1 and Sheet2 respectively. if not you'll know where to change.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = ActiveCell.Column Then
        refRow = Target.Row - 1
        thisRow = Target.Row
        Range("A" & refRow & ":A" & refRow).Copy Range("A" & thisRow & ":A" & thisRow)
        Sheets("Sheet1").Range("A" & refRow & ":B" & refRow).Copy Sheets("Sheet1").Range("A" & thisRow & ":B" & thisRow)
        Sheets("Sheet2").Range("A" & refRow & ":B" & refRow).Copy Sheets("Sheet2").Range("A" & thisRow & ":B" & thisRow)
    End If
End Sub

Run a macro for all sheets to insert a row and copy formula from above cells

1 Answers