Copy/Paste 不同工作簿之间的值

Question

我想使用 VBA 从一个工作簿中复制一系列数据并将其粘贴到另一个工作簿中。为了知道将信息粘贴到哪里，我搜索了下一个空行。

在尝试复制粘贴值时，代码成功运行到最后一部分。我没有收到任何错误，也没有任何成功或失败的迹象。我可以看到它被正确复制（行进点），并且选择了正确的单元格，但没有粘贴任何内容。

Sub Button1_Click()
   Dim wb1 As Workbook
   Dim sht As Worksheet
   Dim rng As Range
   Dim databasewb As Workbook
   Dim databasesht As Worksheet
   Dim eRow As Integer

    'set workbooks to variables

    Set databasewb = Workbooks("Aged Debt Data V1.xlsm")

    Set wb1 = Workbooks.Open("C:\Users\roanderson\Desktop\Aged debt\Templates\BIO Inc (IO) Template.xlsx")


    'select sheet where data lies

    Set sht = wb1.Sheets("Conversion to aged debt format")
    sht.Activate

    'copy range on sheet

    Set rng = sht.Range("A2", Range("A2").End(xlDown).End(xlToRight))
    rng.Copy


    ' paste range into database

     'activate database workbook
    databasewb.Activate

    'find next empty row
    eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    MsgBox (eRow)

    'paste values into empty row
    Sheet1.Cells(eRow, 1).Select
    rng.PasteSpecial Paste:=xlPasteValues
    wb1.Close

End Sub

要粘贴到数据库工作簿中的数据，

Answer 1

将rng.pastespecial改为 selection.pastespecial

Answer 2

如果可能，请尽量避免将复制粘贴与 VBA 以及 avoid using select 一起使用。由于您只想复制值，因此使用 VBA 的 Value 方法可能会更容易。修改您尝试粘贴特殊设置值的代码行。见下文

'paste values into empty row
Sheet1.Cells(eRow, 1).Resize(RNG.Rows.Count, RNG.Columns.Count).Value = RNG.Value
wb1.Close

从 Cells(erow,1) 开始，代码使用 Resize 将起始范围设置为相同的行数和列数或您的变量 RNG。然后它只是设置值，与 CopyPasteValue 相同的结果只是开销更少。

但是，如果您确实想保留复制粘贴值的方法，请修改您的代码：

'paste values into empty row
Sheet1.Cells(eRow, 1).PasteSpecial Paste:=xlPasteValues
wb1.Close

Answer 3

复制粘贴值的性能改进。模块化子.

建议绕过剪贴板以仅粘贴值。 PasteSpecial效率较低。

参见第 8 节：https://techcommunity.microsoft.com/t5/excel/9-quick-tips-to-improve-your-vba-macro-performance/m-p/173687

Sub CopyPasteSingleCol 粘贴到 PasteFirstRow 用于单列。

sub CopyPasteSingleCol2firstBlank 在单列的列中的最后一个空白之后粘贴。

Sub CopyPasteSingleCol(SrcSheet As Worksheet, ByVal SrcCol As String, ByVal SrcFirstRow As Long, _
                       PasteSheet As Worksheet, ByVal PasteCol As String, ByVal PasteFirstRow As Long)
    Dim SrcLastRow As Long
    Dim PasteLastrow As Long
    Dim SrcRng As Range
    Dim PasteRng As Range

    SrcLastRow = SrcSheet.Cells(SrcSheet.Rows.Count, SrcCol).End(xlUp).Row
   
    Set SrcRng = SrcSheet.Range(SrcCol & SrcFirstRow & ":" & SrcCol & SrcLastRow)
    Set PasteRng = PasteSheet.Range(PasteCol & PasteFirstRow)
   SrcRng.Copy PasteRng
End Sub


Sub CopyPasteSingleCol2firstBlank(SrcSheet As Worksheet, ByVal SrcCol As String, ByVal SrcFirstRow As Long, _
                                  PasteSheet As Worksheet, ByVal PasteCol As String)
    Dim SrcLastRow As Long
    Dim PasteLastrow As Long
    Dim SrcRng As Range
    Dim PasteRng As Range
    
        SrcLastRow = SrcSheet.Cells(SrcSheet.Rows.Count, SrcCol).End(xlUp).Row
        PasteLastrow = PasteSheet.Cells(PasteSheet.Rows.Count, PasteCol).End(xlUp).Row + 1
        ' If first row is empty there was not need to add +1 to Lastrow
        If PasteSheet.Cells(1, PasteCol) = vbNullString Then PasteLastrow = 1
        Set SrcRng = SrcSheet.Range(SrcCol & SrcFirstRow & ":" & SrcCol & SrcLastRow)
        Set PasteRng = PasteSheet.Range(PasteCol & PasteLastrow)

   SrcRng.Copy PasteRng
End Sub

Sub TESTCopyPasteSingleCol()
Dim SrcSheet As Worksheet
Dim PasteSheet As Worksheet

'Must qualify your Sheet by using Set before calling sub
Set SrcSheet = Workbooks("importGsheettoExcel3.xlsm").Worksheets("SH1")
Set PasteSheet = Workbooks("importGsheettoExcel.xlsm").Worksheets("SH2")

Call CopyPasteSingleCol(SrcSheet, "B", 2, _
                        PasteSheet, "G", 2)
End Sub

Sub TESTCopyPasteSingleCol2firstBlank()
Dim SrcSheet As Worksheet
Dim PasteSheet As Worksheet

'Must qualify your Sheet by using Set before calling sub
Set SrcSheet = Workbooks("importGsheettoExcel3.xlsm").Worksheets("SH1")
Set PasteSheet = Workbooks("importGsheettoExcel.xlsm").Worksheets("SH2")
Call CopyPasteSingleCol2firstBlank(SrcSheet, "B", 2, _
                                   PasteSheet, "G")
End Sub

Copy/Paste 不同工作簿之间的值

Copy/Paste Value Between Different Workbooks

excel

vba

copy-paste