Doppelklick überträgt einen Wert

[maine-coon]

Ich möchte den Wert aus dem Blatt "Monat" nehmen und als Wert in das Blatt Überstunden eintragen.
Aber nur der Wert, sonst wird ja die ganze Formatierung mitgenommen.

Ich mache einen Doppelklick in der Zelle, bekomme meine Sicherheitsfrage und nach JA
steht hier der Wert drin.
So wie ich es unten gebastelt habe, geht es nicht.

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set temp = Intersect(Range("Monatsbereich"), Target)
If Not temp Is Nothing Then
  Cancel = True
   meldung = MsgBox("Soll der Wert aus der Tabelle Monat" & vbNewLine & _
             "in die Tabelle Jahresübersicht kopiert werden?" & vbNewLine & _
             "" & vbNewLine & _
             "Wert kopieren", vbYesNo, "__")
   If meldung = vbNo Then
      Exit Sub
   End If

Rem Einfügen des Wert
   Worksheets("Monat").Range("M36").Copy
   Worksheets("Überstunden").Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
End If
End Sub

Was muss ich ändern?
Kann mir jemand auf die Sprünge helfen?

[Kuwer]

Hallo Achim,

es gibt nur eine ActiveCell. Deshalb vielleicht so:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Cancel = True
  Application.ScreenUpdating = False
  Target.Copy
  Worksheets("Überstunden").Activate
  ActiveCell.Value = Target.Value
  Me.Activate
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

Gruß Uwe

[maine-coon]

Hallo Uwe,

ich habe den Code entsprechend angepasst.
Funktioniert einwandfrei.
Vielen Dank für deinen Hilfe dazu.

Allerdings habe ich deinen Hinweis mit "Es gibt nur eine ActiveCell" nicht ganz verstanden.
Grundsätzlich klar, es kann nur EINE Zelle die aktiv sein.
Aber was war denn an meinem Eingangscode falsch in Bezug auf deinem Hinweis?

[Kuwer]

Hallo Achim,

Allerdings habe ich deinen Hinweis mit "Es gibt nur eine ActiveCell" nicht ganz verstanden.
Grundsätzlich klar, es kann nur EINE Zelle die aktiv sein.
Aber was war denn an meinem Eingangscode falsch in Bezug auf deinem Hinweis?

die Selection eines inaktiven Blattes, welche die aktive Zelle ist oder enthält, wenn dieses Blatt aktiviert werden würde, kann man nicht ermitteln.

Gruß Uwe

[maine-coon]

Hallo Uwe,
danke für die Aufklärung.
Ich habe den ganzen Code jetzt noch etwas verändert. Läuft richtig gut.
Alles super jetzt.

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Zellbereich As Range
Set Zellbereich = Intersect(Range("Monatsbereich"), Target)
If Not Zellbereich Is Nothing Then
   Cancel = True
   Application.Intersect(Target.EntireRow, Zellbereich).Interior.Color = vbYellow
   meldung = MsgBox("Soll der Wert aus der Tabelle Monat" & vbNewLine & _
             "in die Tabelle Jahresübersicht kopiert werden?" & vbNewLine & _
             "" & vbNewLine & _
             "Wert kopieren", vbYesNo, "__")
      If meldung = vbNo Then
          Application.Intersect(Target.EntireRow, Zellbereich).Interior.Color = vbWhite
          Exit Sub
      End If

Rem Einfügen des Wert
      Cancel = True
      Application.ScreenUpdating = False
      Worksheets("Monat").Range("M36").Copy
      Worksheets("Überstunden").Activate
      ActiveCell.Value = Worksheets("Monat").Range("M36")
      Me.Activate
      Application.CutCopyMode = False
      Application.ScreenUpdating = True
      Application.Intersect(Target.EntireRow, Zellbereich).Interior.Color = vbWhite
  End If
End Sub

Wünsche dir einen schönen Sonntag.
Gruß Achim

[Steffl]

Hallo Achim,

diese Codezeile

Code:

Worksheets("Monat").Range("M36").Copy

braucht es nicht mehr und auch das zweite Cancel = True ist nicht mehr nötig.

[maine-coon]

Habe die beiden Zeilen rausgenommen.
Danke für den Hinweis.
Gruß Achim

[Kuwer]

Hallo Achim,

Habe die beiden Zeilen rausgenommen.

und diese Zeile ist so gewollt!?

ActiveCell.Value = Worksheets("Monat").Range("M36")

Gruß Uwe

[maine-coon]

Ja, so funktioniert es gut...

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Zellbereich As Range
Set Zellbereich = Intersect(Range("Monatsbereich"), Target)
If Not Zellbereich Is Nothing Then
    Cancel = True
    Application.Intersect(Target.EntireRow, Zellbereich).Interior.Color = vbYellow
    meldung = MsgBox("Soll der Wert aus der Tabelle Monat" & vbNewLine & _
              "in die Tabelle Jahresübersicht kopiert werden?" & vbNewLine & _
              "" & vbNewLine & _
              "Wert kopieren", vbYesNo, "__")
       If meldung = vbNo Then
           Application.Intersect(Target.EntireRow, Zellbereich).Interior.Color = vbWhite
           Exit Sub
       End If

Rem Einfügen des Wert
       'Cancel = True
       Application.ScreenUpdating = False
       'Worksheets("Monat").Range("M36").Copy
       Worksheets("Überstunden").Activate
       ActiveCell.Value = Worksheets("Monat").Range("M36")
       Me.Activate
       Application.CutCopyMode = False
       Application.ScreenUpdating = True
       Application.Intersect(Target.EntireRow, Zellbereich).Interior.Color = vbWhite
   End If
End Sub

[Kuwer]

Ja, so funktioniert es gut...

wenn es egal sein soll, welche Zelle man doppelklickt, ist es ja gut.

Gruß Uwe