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("\SCF1USERS-DRobertMy DocumentsExcel VBA codeMeat.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.