Nur Werte einfügen

[FrankM]

Ich wollte beim Kopieren nur Werte einfügen und habe es mit diesem kleinen Trick geschafft:

Code:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim lastAction As String
  On Error Resume Next
  lastAction = Application.CommandBars("Standard").Controls("&Rückgängig").List(1)
  If Left(lastAction, 8) = "Einfügen" And Application.CutCopyMode = xlCopy Then
    With Application
        .EnableEvents = False
        .undo
        .EnableEvents = True
    End With
    Selection.PasteSpecial paste:=(xlPasteValues), Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
   End If
End Sub

Er macht jedes Einfügen rückgängig und fügt nochmal nur die Werte ein. Dabei geht die Formatierung nicht verloren. Ich habe das von hier adaptiert. Es funktioniert. Der VBA-Code muss in jedes Blatt unter "Worksheet", "Change" gesetzt werden. Gibt es dazu Kommentare?

[schauan]

Hallöchen,

Der VBA-Code muss in jedes Blatt unter "Worksheet", "Change" gesetzt werden.

Wenn das in jedem Blatt der Mappe wirken soll, dann schaue mal zu den Ereignismakros in DieseArbeitsmappe

[FrankM]

@schauan
Es funktioniert leider nicht, wenn man es nur in DieseArbeitsmappe schreibt. Es funktioniert nur, wenn man es in das Blatt einfügt, auf dem es wirken soll.

[schauan]

Hallöchen,

was Bei Dir nicht funktioniert, kann ich nicht nachvollziehen. Ich vermute, Du hast den gesamten Code einfach kopiert und dort eingefügt. Ich schrieb aber:

dann schaue mal zu den Ereignismakros in DieseArbeitsmappe

Hast Du geschaut?


Korrekt müsste es so aussehen. Ich habe mal noch zwei Zeilen ergänzt, damit das Makro nicht doppelt durchlaufen wird. Es funktioniert sowohl wenn ich auf einem Blatt etwas kopiere und einfüge als auch wenn ich das Kopierte auf einem anderen Blatt einfüge.

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Dim lastAction As String
  On Error Resume Next
  Application.EnableEvents = False
  lastAction = Application.CommandBars("Standard").Controls("&R?ckg?ngig").List(1)
  If Left(lastAction, 8) = "Einf?gen" And Application.CutCopyMode = xlCopy Then
    With Application
        .EnableEvents = False
        .Undo
        .EnableEvents = True
    End With
    Selection.PasteSpecial Paste:=(xlPasteValues), Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
   End If
  Application.EnableEvents = True
End Sub