Private
Sub
Worksheet_SelectionChange(
ByVal
Target
As
Range)
If
Target.CountLarge > 1
Then
Exit
Sub
If
Target.Column = 1
Or
Target.Column = 2
Then
If
Target.Row > 1
And
Target =
""
Then
If
Target.Offset(-1) <>
""
Then
Application.EnableEvents =
False
formelnschreiben
Application.Goto Target
Application.EnableEvents =
True
End
If
End
If
End
If
End
Sub
Sub
formelnschreiben()
Dim
arSp, itm, rng
As
Range, i
As
Long
, bolisformula
As
Boolean
Dim
stextformula
As
String
Dim
lrow
As
Long
arSp = Split(
"G,H,I,K,M,O"
,
","
)
lrow = ActiveCell.Row
On
Error
GoTo
ERRORHANDLING
Application.ScreenUpdating =
False
For
Each
itm
In
arSp
Set
rng = Intersect(UsedRange, Columns(itm))
If
Not
rng
Is
Nothing
Then
For
i = rng.Rows.Count
To
1
Step
-1
If
rng(i, 1).HasFormula
Then
rng(i, 1).Copy
Cells(lrow, rng.Column).PasteSpecial 11
Application.CutCopyMode =
False
Exit
For
End
If
Next
End
If
Next
ERRORHANDLING:
Application.ScreenUpdating =
True
End
Sub