Question

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

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

我会试着用一个例子来解释我想要的东西。

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

我真的不知道这是否可以完成，因此我无法想出任何可以在此处展示的 VBA 代码。

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

Answer 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

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

1 个答案:

复制行