Excel - Zellenwert durch klicken in andere Zelle kopieren

[alphax]

Guten Tag,
ich habe ein Excel Problem.
Ich wollte das die Zellen E8:G8:I8 beim einzelnen Anklicken, dass der Wert jeweils in der Zelle B7 angezeigt wird.
Als zweites sollten die Zellen C12:E12:G12:I12:K12 beim einzelnen Anklicken, dass jeweils der Wert in der Zelle B14 angezeigt wird.
Das Ganze ist nur auf einem Datenblatt (Tabelle1).
Bisher habe ich mit folgenden Code experimentiert.
Der Code funktioniert, ich bekomme nur die andere Auswahl nicht mit rein.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("C12:E12:G12:I12:K12")) Is Nothing Then
Dim rngZiel As Range
Set rngZiel = Worksheets("Tabelle1").Range("B14")
rngZiel.Value = Target.Value
Cancel = True
End If
End Sub

Was muss ich in dem Code ändern?
Vielen Dank schon mal für die Hilfe.

 

[Scientist]

Code bitte immer in Code-Tags. Unformatierter Code ist immer anstrengend zu lesen.

Du musst nur deine If-Anweisung kopieren und entsprechend auf den neuen Bereich anwenden.

Ansonsten noch ein paar Anmerkungen:
"C12:E12:G12:I12:K12" <- Dass das so funktioniert, wusste ich persoenlich nicht, aber es ist auch grausam meiner Meinung nach. Welcher Bereich soll denn beruecksichtigt werden? Die einzelnen angegeben Zellen oder der komplette Bereich von C12 bis K12?
-> Range("C12, E12, G12, I12, K12") oder Range("C12:K12")

Zeile 3 bsi 5 kannst du zusammenfassen: Worksheets("Tabelle1").Range("B14").Value = Target.Value
Zu erwaehnen ist noch, dass bei der Schreibweise die Funktion nicht mehr funktioniert, wenn das Blatt nicht mehr "Tabelle1" heißt.
Also entweder laesst du auch hier "Worksheets("Tabelle1")." weg oder ich empfehle dir die interne VBA-Bezeichnung zu verwenden. Die findest du links im Projekt-Explorer (Bezeichnung vor der Klammer; Bezeichnung in der Klammer ist die Blattbezeichnung) oder in den Eigenschaften unter "(Name)".
Das saehe dann so aus: Tabelle1.Range("B14").Value = Target.Value

 

[alphax]

Vielen Dank für Ihre schnelle Rückantwort.
Ich habe jetz den Code umgeschrieben auf Ihre Tipps.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("C12, E12, G12, I12, K12")) Is Nothing Then
Dim rngZiel As Range
Set rngZiel = Range("B14")
rngZiel.Value = Target.Value
Cancel = True
End If
End Sub

Das funktioniert perfekt.
Noch eine Frage, wie füge ich jetzt die andere Aktion in den Code ein?
Ich wollte das die Zellen E8, G8, I8 beim einzelnen Anklicken, dass der Wert jeweils in der Zelle B7 angezeigt wird.
Immer nur eine Zelle soll in der Zelle B7 angezeigt werden.
Schon mal vielen Dank für Ihre Bemühungen.

 

[Andreas_]

Wenn Du eine Zelle anklickst, dann änderst Du ja die aktuelle Auswahl. Deswegen kannst Du Worksheet_SelectionChange verwenden.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("E8, G8, I8")) Is Nothing Then
    ' Nur ausführen wenn eine einzelne Zelle angeklickt wurde
    If Target.Cells.Count > 1 Then
      Exit Sub
    End If
    Dim rngZiel As Range
    Set rngZiel = Range("B7")
    rngZiel.Value = Target.Value
    Cancel = True
  End If
End Sub

 

[alphax]

Wenn Du eine Zelle anklickst, dann änderst Du ja die aktuelle Auswahl. Deswegen kannst Du Worksheet_SelectionChange verwenden.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("E8, G8, I8")) Is Nothing Then
    ' Nur ausführen wenn eine einzelne Zelle angeklickt wurde
    If Target.Cells.Count > 1 Then
      Exit Sub
    End If
    Dim rngZiel As Range
    Set rngZiel = Range("B7")
    rngZiel.Value = Target.Value
    Cancel = True
  End If
End Sub

Vielen Dank für Ihre schnelle Hilfe.
Ich habe das gleich mal ausprobiert, das funktioniert perfekt.
Da habe ich noch ein Problen, wie füge ich die folgende Aktion mit in den Code ein?
Als zweites sollten die Zellen C12, E12, G12, I12, K12 beim einzelnen Anklicken, dass jeweils der Wert in der Zelle B14 angezeigt wird.
Vieleicht haben Sie da noch eine Lösung.
Vielen Dank

 

[Andreas_]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim rngZiel As Range
  ' Nur ausführen wenn eine einzelne Zelle angeklickt wurde
  If Target.Cells.Count > 1 Then
    Exit Sub
  End If
  If Not Intersect(Target, Range("E8, G8, I8")) Is Nothing Then
    Set rngZiel = Range("B7")
    rngZiel.Value = Target.Value
    Cancel = True
  ElseIf Not Intersect(Target, Range("C12, E12, G12, I12, K12" )) Is Nothing Then
    Set rngZiel = Range("B14")
    rngZiel.Value = Target.Value
    Cancel = True
  End If
End Sub

/edit: habs geändert, habe kein Excel zum Testen

 

[alphax]

Vielen Dank für Ihre schnelle Hilfe.
Ich habe das gleich mal ausprobiert, das funktioniert perfekt.
Da habe ich noch ein Problen, wie füge ich die folgende Aktion mit in den Code ein?
Als zweites sollten die Zellen C12, E12, G12, I12, K12 beim einzelnen Anklicken, dass jeweils der Wert in der Zelle B14 angezeigt wird.
Vieleicht haben Sie da noch eine Lösung.
Vielen Dank

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  ' Nur ausführen wenn eine einzelne Zelle angeklickt wurde
  If Target.Cells.Count > 1 Then
    Exit Sub
  End If
  If Not Intersect(Target, Range("E8, G8, I8")) Is Nothing Then
    Dim rngZiel As Range
    Set rngZiel = Range("B7")
    rngZiel.Value = Target.Value
    Cancel = True
  ElseIf Not Intersect(Target, Range("C12, E12, G12, I12, K12" )) Is Nothing Then
    Dim rngZiel As Range
    Set rngZiel = Range("B14")
    rngZiel.Value = Target.Value
    Cancel = True
  End If
End Sub

Danke noch mal für Ihre Bemühungen.
Ich habe den Code gleich ausprobiert, da kommt eine Fehlermeldung (Bild im Anhang)

 

[alphax]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim rngZiel As Range
  ' Nur ausführen wenn eine einzelne Zelle angeklickt wurde
  If Target.Cells.Count > 1 Then
    Exit Sub
  End If
  If Not Intersect(Target, Range("E8, G8, I8")) Is Nothing Then
    Set rngZiel = Range("B7")
    rngZiel.Value = Target.Value
    Cancel = True
  ElseIf Not Intersect(Target, Range("C12, E12, G12, I12, K12" )) Is Nothing Then
    Set rngZiel = Range("B14")
    rngZiel.Value = Target.Value
    Cancel = True
  End If
End Sub

/edit: habs geändert, habe kein Excel zum Testen

Jetzt funktioniert es perfekt.
Vielen Vielen Dank für Ihre Hilfe.