How to copy row from Excel sheet and paste it in another workbook in a specific row

Question

In Workbook 1, I have a spreadsheet that tracks the inventory of meat products. Row 1 is used for the column names: "Parcel Tracking Number" in column A and other data related to the parcel in the other columns (Such as "Date of export", "Weight" and "Content" among other things).

Column I describes the parcel's "Content" and these parcels all contain "Meat".

The rows of information in this spreadsheet have been copied from Workbook 2 which contains parcels that contain "Meat", "Cheese", "Milk" and "Eggs" in column I.

Both workbooks have the same columns names in row 1.

In workbook 1, I update the data on some of the rows and I want the change to be applied in Workbook 2 by copying workbook 1 rows and pasting them in Workbook 2 in the rows where the "Parcel Tracking Number" in column A matches.

So far, I have the code to copy all the "Meat" parcel rows from Workbook 2 and paste them in Workbook 1 but now I need help with this new situation.

The program is executed by opening Workbook 2 and pressing a command button which opens workbook 1 and starts copying the rows to the Meat worksheet.

Here it is:

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

Any help is greatly appreciated. Thanks.

Consider using a database (like sibling app, MS Access) for better management of structured data without copy/paste and looping process. — Parfait
Can the updated rows by identified or do you want all the rows to be copied regardless ? — CDP1802

CDP1802 CDP1802 · Accepted Answer · 2020-03-17T18:03:16

Use Find to check if Tracking Number exists and to locate row when transferring data back to Products.

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

How to copy row from Excel sheet and paste it in another workbook in a specific row

1 Answers