将工作簿上的数据复制并粘贴到已打开的工作簿中答案

【问题标题】：Copy and paste data from on workbook into an already opened workbook将工作簿上的数据复制并粘贴到已打开的工作簿中
【发布时间】：2021-05-28 04:34:53
【问题描述】：

我对 VBA 还很陌生，不确定是否可以这样做。

我想将两行数据粘贴到已经打开的工作簿中。

我会试着用一个例子来解释一下我想要什么。

考虑一个工作簿“A”，其中数据由其他人手动输入。工作簿“B”将在我的系统上保持打开状态。工作簿“B”中的第一行将有标题。在标题下方插入 2 个新行后，我希望复制工作簿“A”的最后 2 行中的数据，然后将其粘贴到已经打开的工作簿“B”中。假设第 10 行和第 11 行是工作簿“A”中的最后 2 行，则应将这两行复制并粘贴到工作簿“B”的第 2 行和第 3 行，然后在顶部插入 2 个新行。工作簿“A”第 10 行的数据应粘贴到工作簿“B”的第 3 行，工作簿“A”的第 11 行应复制到工作簿“B”的第 2 行。工作簿“B”将一直对我保持打开状态，其他人将可以访问工作簿“A”。

我真的不知道这是否可以做到，因此我无法提出任何可以在这里展示的 VBA 代码。

因为这个原因，我想在这里问。希望在这里得到专家的指导。提前致谢

【问题讨论】：

是的，可以做到。这是它的逻辑。 1. 识别您的对象。例如Set wbThis = ThisWorkBook 对应Workbook A 和Set wbThat = Workbooks("B") 对应Workbook B 2。同样设置您的相关工作表。 Set wsThis = wbThis.Sheets("Sheet1") 和 Set wsThat = wbThat.Sheets("Sheet1")。根据需要更改工作簿和工作表的名称。 3. Find last row in wsThis
4. 从wsThis 复制最后一行并将复制的行插入wsThat 的第二行。录制宏以查看如何执行此操作。 5. 对(Lastrow-1) 重复该步骤。

标签： excel vba

【解决方案1】：

复制行

调整常量部分中的值。

Option Explicit

Sub copyRows()
    
    ' Constants
    
    Const swbName As String = "A.xlsx" ' Source Workbook Name
    Const sName As String = "Sheet1" ' Source Worksheet Name
    
    Const dName As String = "Sheet1" ' Destination Worksheet Name
    Const dFirst As Long = 2 ' Destination Insert Row
    
    Const rRows As Long = 2 ' Number of rows to be inserted (copied)
    
    ' Destination
    
    ' Workbook/Worksheet
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Worksheets(dName)
    
    ' Source
    
    ' Workbook/Worksheet
    Dim swb As Workbook: Set swb = Workbooks(swbName)
    Dim sws As Worksheet: Set sws = swb.Worksheets(sName)
    
    ' Attempt to find the last non-empty cell.
    Dim sCell As Range
    Set sCell = sws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious)
    If sCell Is Nothing Then Exit Sub ' no data in worksheet
    
    ' Write the row of the last non-empty cell to a variable (Source Last Row).
    Dim sLast As Long: sLast = sCell.Row
    
    ' Validate Source Last Row
    If sLast < rRows Then Exit Sub ' too few rows of data
    
    ' Insert/Copy
    
    Dim r As Long ' Destination Rows Counter
    
    For r = 1 To rRows
        dws.Rows(dFirst).Insert
        sws.Rows(sLast - rRows + r).Copy dws.Rows(dFirst)
    Next r
    
End Sub

【讨论】：