|
Das habe ich als OneClick Event gefunden.
Bin nur leider zu doof das umzuschreiben......
Dim Zielzelle As Range
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Call Workbook_SheetSelectionChange(Sh, Target)
Cancel = True
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim frage As VbMsgBoxResult
If Sh.Name = "Musterwerk" And (Not Intersect(Target, Range("J:J")) Is Nothing Or Not Intersect(Target, Range("AK:AK")) Is Nothing) Then
Set Zielzelle = Target.Cells(1)
Worksheets("Risikoeinschätzung").Select
ElseIf Sh.Name = "Risikoeinschätzung" And Not Zielzelle Is Nothing And Not Intersect(Target, Range("D7:H11")) Is Nothing Then
If Zielzelle.Value <> "" Then frage = MsgBox("Möchten Sie die Werte in H" & Zielzelle.Row & ":J" & Zielzelle.Row & " überschreiben?", vbYesNo) Else frage = vbYes
If frage = vbYes Then
Zielzelle.Value = Target.Value
Zielzelle.Offset(0, -2) = Sh.Cells(Target.CurrentRegion.Rows(2).Row, Target.Column)
Zielzelle.Offset(0, -1) = Sh.Cells(Target.Row, Target.CurrentRegion.Columns(2).Column)
Worksheets("Musterwerk").Select
End If
End If
End Sub
Was meint ihr?
LG
|