在vba中更改工作簿后如何保留剪贴板数据？

我有一个程序，可以复制一系列单元格，并且需要将内容粘贴到用代码创建的新工作簿中。我可以复制数据，但每当我将工作簿更改为新创建的工作簿时，剪贴板会丢失数据。我考虑过将单元格复制到数组中，然后将数组复制到新工作簿中，但在编码时我不知道数组的大小，几乎每次宏运行时都会发生变化。 在更改活动工作簿时，如何将数据保留在剪贴板上

cell = "k7: l" & row
Worksheets(1).Range(cell).Select


Selection.Copy
relpath = ThisWorkbook.Path & "\" & "DispersionList.xls"

If Dir(relpath) <> "" Then
   Application.Workbooks.Open (relpath)
   Workbooks("DispersionList.xls").Activate
Else
    Call createWorkbook
End If

Worksheets(1).Cells(7, 14).Select
Selection.PasteSpecial


End Sub

cell=“k7:l”和行
工作表（1）.范围（单元格）.选择
选择，复制
relpath=ThisWorkbook.Path&“\”和“DistributionList.xls”
如果Dir（relpath）“，则
Application.Workbooks.Open（relpath）
工作簿（“DispersionList.xls”）。激活
其他的
调用createWorkbook
如果结束
工作表（1）.单元格（7,14）.选择
选择特别的
端接头

---

如果我逐行运行代码并检查剪贴板，它会在工作簿中丢失其内容。open line

Excel/VBA中有一些操作会使选择/剪贴板无效，例如更改任何窗口/显示设置。因此，我怀疑在更改工作表/工作簿时调用了某个事件

您可以调试它，并在单步执行代码时找出选择无效的时间，避免使用此语句（如果可能）

或者，在事件代码的下面代码中使用

subStoreClipboard

和

subRestoreClipboard

。要使用该代码，请将其插入工作表中的新模块中，并在VBA中插入一个名为“ws_Temp”的新（隐藏）工作表

---

剪贴板是由windows维护的，因此您不应该丢失数据，除非您告诉它。如果可能，请张贴您的代码。此外，您还可以重拨阵列（x，y）如果您需要动态调整它的大小。@PortlandRunner这正是我编写代码时的推理，但不知何故，数据神秘地消失了，我甚至尝试将其手动粘贴到其他地方，但剪贴板是空的。为什么不执行以下任一操作1）在打开目标工作簿后复制所需的范围（这将避免您遇到的这种奇怪情况），或2）使用范围数组复制或直接写入范围到范围值，而不是依赖复制/粘贴方法。另外，不用说，您应该尽可能删除

选择

和

活动

方法，这通常是可以删除它们的99%的时间。问题是我无法在复制的文档中添加新工作表，它已被锁定。您应该将工作表添加到放置代码的文件中！：-）如果由于某些奇怪的原因无法实现，您也可以在代码中插入临时工作表，然后将其删除。这也可以在任何其他工作簿中完成…我尝试了您的代码，但它被finalize块中的subStoreClipboard函数卡住，在“

ws\u activesource.activate

和

resume finalize

之间不断跳转。如果我把它注释掉，它会一直运行，但是会在subRestoreClipboard函数中卡住。在

案例xlCopy:mRingClipboard.copy上给我一条错误消息。
Private mIntCutCopyMode As XlCutCopyMode
Private mRngClipboard As Range

Public Sub subStoreClipboard()
    On Error GoTo ErrorHandler
    Dim wsActiveSource As Worksheet, wsActiveTarget As Worksheet
    Dim strClipboardRange As String

    mIntCutCopyMode = Application.CutCopyMode

    If Not fctBlnIsExcelClipboard Then Exit Sub


    Application.EnableEvents = False

    'Paste data as link
    Set wsActiveTarget = ActiveSheet
    Set wsActiveSource = ThisWorkbook.ActiveSheet

    With ws_Temp
        .Visible = xlSheetVisible
        .Activate
        .Cells(3, 1).Select
        On Error Resume Next
        .Paste Link:=True
        If Err.Number Then
            Err.Clear
            GoTo Finalize
        End If
        On Error GoTo ErrorHandler
    End With

    'Extract link from pasted formula and clear range
    With Selection
        strClipboardRange = Mid(.Cells(1, 1).Formula, 2)
        If .Rows.Count > 1 Or .Columns.Count > 1 Then
            strClipboardRange = strClipboardRange & ":" & _
                Mid(.Cells(.Rows.Count, .Columns.Count).Formula, 2)
        End If
        Set mRngClipboard = Range(strClipboardRange)
        .Clear
     End With

Finalize:
    wsActiveSource.Activate
    wsActiveTarget.Parent.Activate
    wsActiveTarget.Activate

    ws_Temp.Visible = xlSheetVeryHidden
    Application.EnableEvents = True

    Exit Sub
ErrorHandler:
    Err.Clear
    Resume Finalize
End Sub


Public Sub subRestoreClipboard()
    Select Case mIntCutCopyMode
        Case 0:
        Case xlCopy: mRngClipboard.Copy
        Case xlCut:  mRngClipboard.Cut
    End Select

End Sub

Private Function fctBlnIsExcelClipboard() As Boolean
    Dim var As Variant
    fctBlnIsExcelClipboard = False
    'check if clipboard is in use
    If mIntCutCopyMode = 0 Then Exit Function
    'check if Excel data is in clipboard
    For Each var In Application.ClipboardFormats
        If var = xlClipboardFormatCSV Then
            fctBlnIsExcelClipboard = True
            Exit For
        End If
    Next var
End Function