Option
Explicit
Private
Const
iOffset
As
Integer
= 2
Private
Const
sRange
As
String
=
"C4:C6"
Dim
sValues()
As
String
Private
Sub
Worksheet_Change(
ByVal
Target
As
Range)
On
Error
Resume
Next
Dim
c
As
Range, s
As
String
For
Each
c
In
Target.Cells
s = getValueFromArray(c.address)
If
Not
s = vbNullString
Then
c.Offset(0, iOffset).Value = s
End
If
Next
c
On
Error
GoTo
0
End
Sub
Private
Sub
Worksheet_SelectionChange(
ByVal
Target
As
Range)
Dim
rng
As
Range
Set
rng = Intersect(Target, Range(sRange))
If
rng
Is
Nothing
Then
Exit
Sub
End
If
Dim
c
As
Range, l
As
Long
ReDim
sValues(Target.Cells.Count - 1, 1)
For
Each
c
In
Target.Cells
sValues(l, 0) = c.address
sValues(l, 1) = c.Value
l = l + 1
Next
c
End
Sub
Private
Function
getValueFromArray(
ByVal
address
As
String
)
As
String
Dim
l
As
Long
For
l = 0
To
UBound(sValues(), 1)
If
sValues(l, 0) = address
Then
getValueFromArray = sValues(l, 1)
Exit
Function
End
If
Next
l
End
Function