如何从 Excel 工作表复制行并将其粘贴到特定行的另一个工作簿中

Question

在工作簿 1 中，我有一个跟踪肉类产品库存的电子表格。 第 1 行用于列名称：A 列中的“包裹追踪编号”以及其他列中与包裹相关的其他数据（例如“出口日期”、“重量”和“内容”等）。

第一列描述了包裹的“内容”，这些包裹都包含“肉类”。

此电子表格中的信息行是从工作簿 2 中复制的，其中包含第一列中包含“肉类”、“奶酪”、“牛奶”和“鸡蛋”的包裹。

两个工作簿在第 1 行中具有相同的列名。

在工作簿 1 中，我更新了某些行的数据，并且我希望通过复制工作簿 1 的行并将它们粘贴到工作簿 2 中列中“包裹跟踪号”的行中的方式在工作簿 2 中应用更改A 匹配。

到目前为止，我有从工作簿 2 复制所有“肉类”包裹行并将它们粘贴到工作簿 1 中的代码，但现在我需要帮助来应对这种新情况。

通过打开工作簿 2 并按下命令按钮来执行程序，该按钮打开工作簿 1 并开始将行复制到 Meat 工作表。

这里是：

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False ' Screen Update application turned off in order to make program run faster
Dim y As Workbook ' 
Dim sh As Worksheet ' 

Set y = Workbooks.Open("\\SCF1\USERS-D\Robert\My Documents\Excel VBA code\Meat.xlsx") ' 
a = ThisWorkbook.Worksheets("Products").Cells(Rows.Count, 1).End(xlUp).Row 


Set sh = Workbooks("Meat.xlsx").Worksheets("Meat") 
With ThisWorkbook.Worksheets("Products") 


For i = 2 To a ' value ''i'' is the column number

    If ThisWorkbook.Worksheets("Products").Cells(i, 9).Value Like "*Meat*" And IsError(Application.Match(.Cells(i, "A").Value, sh.Columns("A"), 0)) Then ' this sets the condition for which the data can only be copied if the row has '' Meat '' included in the 9th column (substance) and if the row is not already copied in the Meat worksheet.

        ThisWorkbook.Worksheets("Products ").Rows(i).Copy 
        Workbooks("Meat.xlsx").Worksheets("Meat").Activate 
        b = Workbooks("Meat.xlsx").Worksheets("Meat ").Cells(Rows.Count, 1).End(xlUp).Row 
        Workbooks("Meat.xlsx").Worksheets("Meat").Cells(b + 1, 1).Select 
        ActiveSheet.Paste 
        ThisWorkbook.Worksheets("Products").Activate 

    End If


Next

On Error Resume Next '1004 error kept appearing so this function allows us to continue to next step without error appearing


ThisWorkbook.Worksheets("Products").Cells(1, 1).Select

End With

MsgBox "All rows from Products worksheet have been copied." 
Application.ScreenUpdating = True

End Sub

非常感谢任何帮助。谢谢。

Answer 1

使用Find检查跟踪号是否存在，并在将数据传回产品时定位行。

Option Explicit

Sub CommandButton1_Click()

    ' update meat
    Const PATH = "\\SCF1\USERS-D\Robert\My Documents\Excel VBA code\"
    Const WB_NAME = "Meat.xlsx"

    Dim wb As Workbook, ws As Worksheet, iLastRow As Long, iRow As Long
    Dim wbTarget As Workbook, wsTarget As Worksheet, iTargetRow As Long

    Set wbTarget = Workbooks.Open(PATH & WB_NAME)
    Set wsTarget = wbTarget.Sheets("Meat")
    iTargetRow = wsTarget.Cells(Rows.count, 1).End(xlUp).Row + 1

    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Products")
    iLastRow = ws.Cells(Rows.count, 1).End(xlUp).Row

    Dim sContent As String, sTrackId As String
    Dim res As Variant, count As Long

    'Application.ScreenUpdating = False
    count = 0
    For iRow = 2 To iLastRow

       sTrackId = ws.Cells(iRow, "A")
       sContent = ws.Cells(iRow, "I")

       If LCase(sContent) Like "*meat*" Then

          ' check not already on sheet
          Set res = wsTarget.Range("A:A").Find(sTrackId)
          If (res Is Nothing) Then
              ws.Rows(iRow).Copy wsTarget.Cells(iTargetRow, 1)
              iTargetRow = iTargetRow + 1
              count = count + 1
          End If

       End If
    Next
    'wbTarget.Save
    'wbTarget.Close

    MsgBox count & " rows inserted from Products worksheet."
    'Application.ScreenUpdating = True

End Sub

Sub CommandButton2_Click()

    ' update product
    Const PATH = "\\SCF1\USERS-D\Robert\My Documents\Excel VBA code\"
    Const WB_NAME = "Meat.xlsx"

    Dim wb As Workbook, ws As Worksheet, iRow As Long
    Dim wbSource As Workbook, wsSource As Worksheet, iLastSourceRow As Long

    Set wbSource = Workbooks.Open(PATH & WB_NAME, False, True) 'no link update, read-only
    Set wsSource = wbSource.Sheets("Meat")
    iLastSourceRow = wsSource.Cells(Rows.count, 1).End(xlUp).Row + 1

    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Products")

    Dim sTrackId As String
    Dim res As Variant, count As Long

    'Application.ScreenUpdating = False
    count = 0
    For iRow = 2 To iLastSourceRow

        sTrackId = wsSource.Cells(iRow, "A")

        ' find row on product sheet
        Set res = ws.Range("A:A").Find(sTrackId)
        If (res Is Nothing) Then
           MsgBox "Could not update " & sTrackId, vbExclamation
        Else
           wsSource.Rows(iRow).Copy ws.Cells(res.Row, 1)
           count = count + 1
        End If

    Next
    wbSource.Close

    MsgBox count & " rows updated from Meat workbook."
    'Application.ScreenUpdating = True

End Sub