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

Question

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

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

此电子表格中的信息行是从 Workbook 2 复制的，其中包含第一列中包含“Meat”、“Cheese”、“Milk”和“Eggs”的包裹。

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

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

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

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

这里是：

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

任何帮助是极大的赞赏。谢谢。

标签： excelvba

Answer 1

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

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