Динамические изменения, необходимые при копировании данных с одного листа на другой

Question

Пожалуйста, ознакомьтесь с приведенным ниже кодом, объяснение дано после кода:

Sub SaveRecord()
Dim DE As Worksheet     ‘Data Entry Sheet
Dim DR As Worksheet ‘Data Record Sheet
Dim PR As Long      ‘Find the row to paste data into

Set DE = Sheet2
Set DR = Sheet6

PR = DR.Range("B" & Rows.Count).End(xlUp).Row

With DR
    .Cells(PR + 1, 2).Value = DE.Range("B6").Value
    .Cells(PR + 1, 3).Value = DE.Range("F6").Value
    .Cells(PR + 1, 4).Value = DE.Range("B7").Value
    .Cells(PR + 1, 5).Value = DE.Range("F7").Value
    .Cells(PR + 1, 6).Value = DE.Range("H6").Value
    .Cells(PR + 1, 7).Value = DE.Range("B11").Value
    .Cells(PR + 1, 8).Value = DE.Range("E11").Value
    .Cells(PR + 1, 9).Value = DE.Range("H11").Value

    .Cells(PR + 1, 10).Value = DE.Range("B14").Value
    .Cells(PR + 2, 10).Value = DE.Range("B15").Value
    .Cells(PR + 3, 10).Value = DE.Range("B16").Value
    .Cells(PR + 4, 10).Value = DE.Range("B17").Value
    .Cells(PR + 5, 10).Value = DE.Range("B18").Value
    .Cells(PR + 6, 10).Value = DE.Range("B19").Value
    .Cells(PR + 7, 10).Value = DE.Range("B20").Value
    .Cells(PR + 8, 10).Value = DE.Range("B21").Value
    .Cells(PR + 9, 10).Value = DE.Range("B22").Value
    .Cells(PR + 10, 10).Value = DE.Range("B23").Value

    .Cells(PR + 1, 11).Value = DE.Range("C14").Value
    .Cells(PR + 2, 11).Value = DE.Range("C15").Value
    .Cells(PR + 3, 11).Value = DE.Range("C16").Value
    .Cells(PR + 4, 11).Value = DE.Range("C17").Value
    .Cells(PR + 5, 11).Value = DE.Range("C18").Value
    .Cells(PR + 6, 11).Value = DE.Range("C19").Value
    .Cells(PR + 7, 11).Value = DE.Range("C20").Value
    .Cells(PR + 8, 11).Value = DE.Range("C21").Value
    .Cells(PR + 9, 11).Value = DE.Range("C22").Value
    .Cells(PR + 10, 11).Value = DE.Range("C23").Value
'
    .Cells(PR + 1, 12).Value = DE.Range("D14").Value
    .Cells(PR + 2, 12).Value = DE.Range("D15").Value
    .Cells(PR + 3, 12).Value = DE.Range("D16").Value
    .Cells(PR + 4, 12).Value = DE.Range("D17").Value
    .Cells(PR + 5, 12).Value = DE.Range("D18").Value
    .Cells(PR + 6, 12).Value = DE.Range("D19").Value
    .Cells(PR + 7, 12).Value = DE.Range("D20").Value
    .Cells(PR + 8, 12).Value = DE.Range("D21").Value
    .Cells(PR + 9, 12).Value = DE.Range("D22").Value
    .Cells(PR + 10, 12).Value = DE.Range("D23").Value
'
    .Cells(PR + 1, 13).Value = DE.Range("E14").Value
    .Cells(PR + 2, 13).Value = DE.Range("E15").Value
    .Cells(PR + 3, 13).Value = DE.Range("E16").Value
    .Cells(PR + 4, 13).Value = DE.Range("E17").Value
    .Cells(PR + 5, 13).Value = DE.Range("E18").Value
    .Cells(PR + 6, 13).Value = DE.Range("E19").Value
    .Cells(PR + 7, 13).Value = DE.Range("E20").Value
    .Cells(PR + 8, 13).Value = DE.Range("E21").Value
    .Cells(PR + 9, 13).Value = DE.Range("E22").Value
    .Cells(PR + 10, 13).Value = DE.Range("E23").Value

    .Cells(PR + 1, 14).Value = DE.Range("F14").Value
    .Cells(PR + 2, 14).Value = DE.Range("F15").Value
    .Cells(PR + 3, 14).Value = DE.Range("F16").Value
    .Cells(PR + 4, 14).Value = DE.Range("F17").Value
    .Cells(PR + 5, 14).Value = DE.Range("F18").Value
    .Cells(PR + 6, 14).Value = DE.Range("F19").Value
    .Cells(PR + 7, 14).Value = DE.Range("F20").Value
    .Cells(PR + 8, 14).Value = DE.Range("F21").Value
    .Cells(PR + 9, 14).Value = DE.Range("F22").Value
    .Cells(PR + 10, 14).Value = DE.Range("F23").Value

End With

End Sub

Во-первых, я хотел бы сообщить, как работает вышеуказанный код

Копирует значения данных из ячеек листа ввода данных в ячейки листа записи данных.

• Обязательная ячейка значения листа ввода данных  B6, F6, B7, F7, H6, E11, H11
• Данные в этих ячейках являются обязательными

** Дополнительные значения Ячейки таблицы ввода данных  B14: F23 ** Минимальные данные в этих ячейках могут быть равны 1, что можетбыть введенным в D14 или E14 и максимум будет 50 в полном диапазоне.

Он вставляет значения данных в ячейки записи данных B5, C5, D5, E5, F5, G5, H5, I5 J5: N14

Поскольку вы заметили, что первая запись начинается с B5 до N14, а вторая запись начинается с B6: N15 (и продолжается далее), посредством которой он перезаписывает данные предыдущих ячеек J5: N14, которые не являютсяприемлемо.

Решение, которое мне было нужно, заключается в следующемd (и продолжить далее) начинается с после ячейки (ей) дополнительных значений, предположения, если значение ячейки листа ввода данных заканчивается в D14, тогда следующая запись будет начинаться из ячейки листа записи данных в B15, если ввод данныхЗначение ячеек листа заканчивается в F21. Затем следующая запись будет начинаться из ячейки записи данных в B22

. Для лучшего понимания я дал ссылку ниже, где я вручную копирую данные из листа ввода данных в лист записи данных.

https://drive.google.com/open?id=1ABg7Db2-ZGCmMTfg_rjqOCQ8HTZFe-9w

Примечание: нет необходимости вносить изменения в приведенный выше код.

Пожалуйста, помогите мне.

Спасибо и С уважением

Muneeb