worksheet change with multiple ranges

[Mark_G]

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

 

[Richard Schollar]

Hi Mark

Does this work:

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

 

[Mark_G]

Thanks, that works great

Mark