Скопируйте только значения ячейки, а не вставьте

Question

Я пытаюсь создать командную кнопку, которая будет запускать скрипт для копирования только значений ячейки.На данный момент у меня есть макрос, который устанавливает ячейки, равные формуле.Когда я копирую ячейки, он хочет скопировать формулу, а не значения.Я хочу, чтобы эта кнопка ТОЛЬКО копировала значения диапазона в буфер обмена для копирования на другой лист.Вот код, который у меня есть.

Эта часть кода используется для формулировки ячеек.

Dim LookupRange As Range
Dim c As Variant

Application.ScreenUpdating = False
Set LookupRange = Range("C9:C300") ' Set range in Column B

For Each c In LookupRange 'Loop through range
    If c.Value <> "" Then 'If value in B is not empty then

     Cells(c.Row, 15).FormulaR1C1 = "=""""&RC[-11]&"" ""&RC[-6]&"" (MK NO. 
     ""&RC[-13]&"")"""

     Cells(c.Row, 14).FormulaR1C1 = "=""""&RC[-11]&"""""


     End If
Next c
Application.ScreenUpdating = True

Эта часть кода используется для копирования только значений этихячейки.

Sub CommandButton_CopyNumbers()

Dim LastR As Long

'FIND LAST ROW OF DATA IN COLUMN N
LastR = Cells(Rows.Count, 14).End(xlUp).Row


Range("K9:N &LastR").Select 'This part is not working
Selection.Copy

End Sub

Первый код работает хорошо, но есть ли способ просто установить эти ячейки равными значению вместо формулы и скопировать их в буфер обмена?

Answer 1

Вы можете сделать что-то вроде этого:

CopyOnlyValues Range("K9:N" & LastR)

Sub для копирования диапазона в виде текста:

Sub CopyOnlyValues(rng As Range)
    'requires project reference to "Microsoft Forms 2.0 Object Library"
    Dim txt, rw As Range, objDat As New DataObject
    Dim c As Range, sepV As String, sepL

    sepL = ""
    For Each rw In rng.Rows
        sepV = ""
        For Each c In rw.Cells
            txt = txt & sepV & c.Value
            sepV = vbTab
        Next c
        txt = txt & vbLf
    Next rw

    objDat.SetText txt
    objDat.PutInClipboard
End Sub

Примечание: производительность может быть не очень высокой на очень большом диапазоне.

Answer 2

Попробуйте

Sub CommandButton_CopyNumbers()

    Dim LastR As Long
    Dim vDB As Variant
    Dim Target As Range
    Dim Ws As Worksheet
    'FIND LAST ROW OF DATA IN COLUMN N
    LastR = Cells(Rows.Count, 14).End(xlUp).Row

    Set Ws = Sheets("Different Worksheet name")

    vDB = Range("K9:N" & LastR)

    Set Target = Ws.Range("a1") 'set your cell one
    Target.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB

End Sub

Answer 3

Вы можете создать подпрограмму и установить комбинацию клавиш "ctrl + v", имитирующую ярлык вставки по умолчанию.

Таким образом мы заменим ярлык вставки по умолчанию новой процедурой, котораявставит только значения скопированного выделения.

Sub PasteAsValues()
'Set the shortcut to "ctrl + v"

Selection.PasteSpecial xlPasteValues

End Sub

Правильный код:

Sub CommandButton_CopyNumbers()

Dim LastR As Long

'FIND LAST ROW OF DATA IN COLUMN N
LastR = Cells(Rows.Count, 14).End(xlUp).Row

Range("K9:N" & LastR).Select 'This part is not working
Selection.Copy

End Sub