leider komme ich bei meinem Vorhaben nicht weiter und hoffe, dass ihr mir helfen könnt.
Hier ist die Datei mit einer Anleitung wie ichs gerne wünsche.
https://www.herber.de/bbs/user/154941.xlsx
Vielen dank.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Zelle1 As Range
Dim Zelle2 As Range
Dim Txt As String
Set Zelle1 = Target
Txt = Intersect(Zelle1.EntireRow, Columns(1)).Value & " - "
Txt = Txt & Intersect(Zelle1.EntireColumn, Rows(2)).Value
Sheets("SeiteB").Select
On Error Resume Next
Set Zelle2 = Application.InputBox("Bitte Wert auswählen für " & vbLf & Txt, Type:=8)
On Error Goto 0
Application.Goto Zelle1
If Not Zelle2 Is Nothing Then Zelle1.Value = Zelle2(1).Value
Cancel = True
End Sub
zum ausführen mach in der SeiteA einen Doppelklick auf die Zelle, die du füllen willst.
Option Explicit
Public KopierenAusführen As Boolean
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
KopierenAusführen = True
Sheets("SeiteB").Select
End Sub
und dieser Code ins Modul von "SeiteB"
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Sheets("SeiteA").KopierenAusführen Then
Cancel = True
Sheets("SeiteA").Select
ActiveCell.Value = Target.Value
End If
End Sub
Private Sub Worksheet_Deactivate()
Sheets("SeiteA").KopierenAusführen = False
End Sub
hier dann einfach in SeiteA die Zelle doppeltklicken, die befüllt werden soll und direkt danach die Zelle in SeiteB.
if not Intersect(Target, Range(..Zellbereich oder Name der Tabelle..)) is nothing then
hier dann der Code
end if
oder du fragst die Postionen ab:
if Target.Row >= 2 and Target.Column >= 2 then
hier der Code
end if
Gruß Daniel
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range(Tabelle13411)) Is Nothing Then
If Sheets("SeiteA").KopierenAusführen Then
Cancel = True
Sheets("SeiteA").Select
ActiveCell.Value = Target.Value
End If
End If
End Sub
leider bekomme ich eine Felermeldung i diesem Bereich: