Копировать содержимое ячейки.

[agregator]

Уважаемые программисты, напишите пожалуйста код, который копирует в буфер только содержимое ячейки, чтобы содержимое осталось в буфере после очищения ячейки.

[SAS888]

Зачем Вам буфер? Присвойте значение ячейки переменной.

[agregator]

SAS888, я хочу сделать, чтобы при правом клике-скопировать содержимое и очистить ячейку, при двойном щелчке вставить в другую ячейку. Или вырезать и вставить в другую ячейку только значение. (Перетащить неменяя формат конечой ячейки.)

[SAS888]

А чем Вас не устраивает существующая в Excel возможность "Вырезать" - "Специальная вставка" - "Значения" ?

[agregator]

После "вырезать" "специальная вставка" не работает.

[agregator]

И хотелось, чтобы формат первой ячейки не изменялся.

[SAS888]

Посмотрите вложение. Выделите ячейки (ячейку), нажмите правую кнопку мыши и выберите в контекстном меню новый пункт "Скопировать и очистить". Затем, выберите требуемую ячейку для вставки и через правую кнопку "Вставить значения".
Эти два новых пункта в контекстном меню ячейки будут создаваться при открытии этой книги и удаляться при ее деактивации. Устроит?

[agregator]

SAS888, классную штуку ты сделал! Но мне удобнее если бы он работал как этот код:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Application.CutCopyMode = 0 Then GoTo a
If Application.CutCopyMode = 0 Or Selection.Cells.Count > 1 Then Exit Sub
If Selection = 0 Then ActiveSheet.Paste Else Exit Sub
Application.CutCopyMode = False
Exit Sub
a: If Selection.Cells.Count > 1 Then Exit Sub
Selection.Cut
End Sub

Я попробовал слепить такой код, но он не работает:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Range("A1") = 0 Then GoTo a
If Selection.Cells.Count > 1 Then Exit Sub
If Selection = 0 Then Selection.Value = xx Else Exit Sub
Range("A1").ClearContents
Exit Sub
a: If Selection.Cells.Count > 1 Then Exit Sub
xx = Selection.Value: Selection.ClearContents: fl = True
Range("A1").FormulaR1C1 = "Вставляй"
End Sub
Можно сделать, чтобы этот код работал?

[agregator]

Вот так работает.
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Range("A1") = 0 Then GoTo a
If Selection.Cells.Count > 1 Then Exit Sub
If Selection = 0 Then Application.Run "InsertValue" Else Exit Sub
Range("A1").ClearContents
Exit Sub
a: If Selection.Cells.Count > 1 Then Exit Sub
Application.Run "CopyAndClearRange"
Range("A1").FormulaR1C1 = "Вставляй"
End Sub

Подскажите как можно выключать этот код, кроме как поставить знак коментария " ' " перед Private Sub.

[SAS888]

1. Чуть рациональнее будет так:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Cells.Count > 1 Then Exit Sub
    If [A1] = 0 Then
        Application.Run "CopyAndClearRange": [A1] = "Вставляй"
    Else
        If Target = 0 Then Application.Run "InsertValue" Else Exit Sub
        [A1].ClearContents
    End If
End Sub

2. Для того, чтобы "выключить" код, можно использовать

Application.EnableEvents = False

Для того, чтобы "включить":

Application.EnableEvents = True