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

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.

Answer 1

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