worksheet change with multiple ranges

Mark_G

Board Regular
Joined
Aug 6, 2004
Messages
123
Hello all,

I am having a little trouble with a worksheet change event. So far I have:

Private Sub Worksheet_Change(ByVal Target As Range)

UnprotectSheets

Dim rng As Range
If Target.Count > 1 Then Exit Sub
Set rng = Range("B11:B20")
If Intersect(Target, rng) Is Nothing Then Exit Sub
Target.Offset(37, 0) = Target

If Target.Count > 1 Then Exit Sub
Set rng = Range("H11:H20")
If Intersect(Target, rng) Is Nothing Then Exit Sub
Target.Offset(37, 0) = Target

If Target.Count > 1 Then Exit Sub
Set rng = Range("A21:H21")
If Intersect(Target, rng) Is Nothing Then Exit Sub
Target.Offset(37, 0) = Target

If Target.Count > 1 Then Exit Sub
Set rng = Range("C23")
If Intersect(Target, rng) Is Nothing Then Exit Sub
Target.Offset(37, 0) = Target

ProtectSheets
End Sub

But it only works for the first range (b11:b20). What I want to be able to do is that if any one of the cells in all the ranges listed above are changed, the value get pasted 37 rows down. How do I have to change my code to make that work. I should mention that another macro pastes special value to the range a8:h23, however, all the ranges listed above will always be blank, so will never have any value pasted into them.

Mark
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Hi Mark

Does this work:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range

UnprotectSheets

Set rng = Range("b11:b20, h11:h20, a21:h21, c23")

If Not Intersect(Target, rng) Is Nothing Then
    Intersect(Target, rng).Offset(37, 0).Value = Intersect(Target, rng).Value
End If
ProtectSheets
End Sub

Best regards

Richard
 
Upvote 0

Forum statistics

Threads
1,211,843
Messages
6,104,310
Members
447,901
Latest member
boy3hc2004

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