Скопируйте и вставьте новые данные из одной рабочей книги в другую после ввода всех необходимых данных

Question

Я работаю с двумя рабочими тетрадями.Одна рабочая книга (DDwb) содержит шаблон списка доставки, а другая рабочая книга (Rwb) содержит запись выполненных поставок, отображающую только ключевую информацию о доставке из шаблона списка доставки.

Каждая новая доставка появляется в шаблоне в новой строке между строками 14 и 27.
Этот шаблон сохраняется в виде отдельного файла в конце месяца.Несколько поставок будут добавлены в течение месяца в разное время.Я хотел бы поймать запись о новой доставке в Rwb, как она добавлена ​​в шаблон.

С точки зрения кода события изменения рабочего листа, я хочу скопировать сводную информацию, как только вся информация для этогодоставка была введена.Например, ячейки: D14, E14, F14 и N14 содержат сводную информацию о ключе для первой поставки в этом месяце.Я хочу подождать, пока все это не будет заполнено.

Кроме того, я хочу очистить свой раздел «значение ячейки> 0», используя свойство «С», но при этом возникают ошибки компиляции.

Как мне дождаться полного заполнения ячеек в соответствующей строке?

Вот код, который у меня есть.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim DDwb As Workbook, Rwb As Workbook
    Dim cel As Range
    Dim myrow As Long

    Set DDwb = ThisWorkbook
    Set Rwb = Workbooks.Open("C:\Users\Admin\OneDrive\Documents (shared)\TEST - job and stock manager.xlsm")

    If Not Intersect(Target, Range("D14:N27")) Is Nothing Then
        For Each cel In Target
            myrow = cel.Row
            Application.EnableEvents = False
            If DDwb.Sheets("DD template (progressive)").Cells(myrow, 4).Value > 0 And DDwb.Sheets("DD template (progressive)").Cells(myrow, 5).Value > 0 And DDwb.Sheets("DD template (progressive)").Cells(myrow, 6).Value > 0 Then
                Application.ScreenUpdating = False
                'insert new row
                Rwb.Sheets("Record of deliveries").Rows("4:4").Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow
                'customer name
                Rwb.Sheets("Record of deliveries").Cells(4, 2) = "Customer name"
                'customer order number
                Rwb.Sheets("Record of deliveries").Cells(4, 3) = DDwb.Sheets("DD template (progressive)").Range("D" & Target.Row)
                'delivery qty
                Rwb.Sheets("Record of deliveries").Cells(4, 4) = DDwb.Sheets("DD template (progressive)").Range("E" & Target.Row)
                'description
                Rwb.Sheets("Record of deliveries").Cells(4, 5) = DDwb.Sheets("DD template (progressive)").Range("F" & Target.Row)
                'delivery date
                Rwb.Sheets("Record of deliveries").Cells(4, 6) = "=TODAY()"
                'DD docket number
                Rwb.Sheets("Record of deliveries").Cells(4, 7) = DDwb.Sheets("DD template (progressive)").Range("L" & Target.Row)
                'delivery notes
                Rwb.Sheets("Record of deliveries").Cells(4, 8) = DDwb.Sheets("DD template (progressive)").Range("N" & Target.Row)
                Rwb.Save
                Application.ScreenUpdating = True
                Application.EnableEvents = True
            End If
        Next cel
    End If

End Sub

Answer 1

• Я почти уверен, что этот Worksheet_Change находится в закрытом шаблоне DD (прогрессивный) кодовом листе рабочего листа, поэтому все ссылки на ThisWorkbook и DDwb.Sheets ("Шаблон DD (прогрессивный)")избыточный.
• Вы переносите значения только из столбцов D, E, F, L & N, поэтому необходимо заполнять только эти ячейки.
• Вы используете формулу =today(), но ядумаю, что вы хотите статический Date.Вы можете отменить это, если хотите.
• Нет необходимости в Dim vars и открытии рабочих книг, пока вы не узнаете, что они вам действительно понадобятся.
• Отключение / включение EnableEvents и ScreenUpdating впетля не нужна.Отключите один раз перед циклом и повторно включите после его завершения.
• Вы по-прежнему хотите открыть целевую книгу, даже не закрывая ее.Я предполагаю, что вы хотите закрыть его между действиями.
• Вы хотите передать значения только один раз, поэтому вам нужно собрать уникальный список задействованных строк;не полный список всех ячеек в Target.
• Обычно рекомендуется предусмотреть некоторую защиту от ошибок.

_{Полная тестовая песочница потребует искусственной сборкивнешней книги, так что не полностью протестировано.}

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("D:F, L:L, N:N"), Range("14:27")) Is Nothing Then
        On Error GoTo safe_exit
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Dim rw As Range
        Static dict As Object, ky As Variant

        If dict Is Nothing Then Set dict = CreateObject("scripting.dictionary")
        dict.RemoveAll

        For Each rw In Intersect(Target, Range("D:F, L:L, N:N"), Range("14:27")).Rows
            'are there 5 values in D:F, L, N of this row?
            If Application.CountA(Intersect(Range("D:F, L:L, N:N"), Rows(rw.Row))) = 5 Then _
                dict.Item(rw.Row) = vbNullString
        Next rw

        if cbool(dict.count) then 
            'we finally know that there are values to transfer; time to open the external workbook
            dim vals As Variant, rwb As Workbook
            Set rwb = Workbooks.Open("C:\Users\Admin\OneDrive\Documents (shared)\TEST - job and stock manager.xlsm")
            For Each ky In dict.keys
               'there are 5 values in D:F, L, N of this row - insert new row
                rwb.Sheets("Record of deliveries").Rows("4:4").Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow
                'collect values
                vals = Array("Customer name", Cells(ky, "D").Value, Cells(ky, "E").Value, Cells(ky, "F").Value, _
                              Date, Cells(ky, "L").Value, Cells(ky, "N").Value)
                'transfer values
                rwb.Sheets("Record of deliveries").Cells(4, 2).Resize(1, 7) = vals
            Next ky

            rwb.Close SaveChanges:=True
        End If
    End If

safe_exit:
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub