Как скопировать строку из листа Excel и вставить ее в другую рабочую книгу в заданную строку c

Question

В Рабочей тетради 1 у меня есть электронная таблица, которая отслеживает запасы мясных продуктов. Строка 1 используется для имен столбцов: «Номер отслеживания посылки» в столбце A и другие данные, связанные с посылкой в ​​других столбцах (например, такие как «Дата экспорта», «Вес» и «Содержимое»).

Столбец I описывает «Содержимое» участка, и все эти участки содержат «Мясо».

Строки информации в этой электронной таблице были скопированы из Рабочей книги 2, в которой содержатся посылки, содержащие столбцы "Мясо", "Сыр", "Молоко" и "Яйца".

Оба рабочие книги имеют одинаковые имена столбцов в строке 1.

В рабочей книге 1 я обновляю данные для некоторых строк и хочу, чтобы изменение было применено в рабочей книге 2, скопировав строки рабочей книги 1 и вставив их в рабочую книгу. 2 в строках, где «номер отслеживания посылки» в столбце A совпадает.

Пока у меня есть код, чтобы скопировать все строки посылки "Мясо" из Рабочей книги 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

Любая помощь с благодарностью. Благодаря.

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