Скопируйте несколько диапазонов и вставьте его на другой лист, в той же строке и в последней пустой строке

Question

У меня есть макрос, в котором я загружаю несколько файлов, копирую первый лист каждого файла и переношу листы в файл «Master».

Отсюда макрос создает сводку всех новыхлисты загружаются в предварительно определенный лист, называемый «Сводка», и делают то же самое с другим листом, называемым «Ошибки».

Я поделюсь кодом с листом «Ошибки», потому что именно на этом мой вопрос (эта частькода, пока не копирует и не вставляет несколько диапазонов):

Как видите, этот код копирует все данные в диапазоне D5: N до последней строки и вставляет их в лист «Ошибки», начиная сиз последней пустой строки.

      Sub WorksheetLoopSummary()

         Dim WS_Count As Integer
         Dim D As Integer
         Dim E As Integer
         Dim lastrow As Long
         Dim SumRange As Range

         WS_Count = ActiveWorkbook.Worksheets.Count

         For E = 5 To WS_Count

            Sheets(E).Select

            If Range("F5") = "" Then

            Else

            lastrow = ActiveSheet.Cells(Rows.Count, "F").End(xlUp).Row
            Range("D5:N" & lastrow).Copy
            lastrow = Sheets("Errors").Range("C65536").End(xlUp).Row
            Sheets("Errors").Range("A" & lastrow + 1).PasteSpecial Paste:=xlPasteValues

            End If
         Next E

End Sub

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

Исходные данные

Желтый диапазон - это тот, который я сейчас копирую, без проблем, но мне нужно будет скопировать диапазон / ячейку также слишком розового цвета и вставить его на лист «Ошибки» в следующем порядке:

Лист ошибок

Для этого у меня есть этот код, отлично работает (я получаю свой вопрос, я обещаю)

Sub CopyPasteMultiRange()
Dim rng As Range
Dim R1 As Range
Dim R2 As Range
Dim mRange As Range
Dim C As Range
Dim LastRowErrors As Integer

LastRowErrors = ActiveSheet.Cells(Rows.Count, "F").End(xlUp).Row

    Set R1 = Range("D5:N5")
    Set R2 = Range("B8")
    Set mRange = Union(R1, R2)

Dim WSEntries As Worksheet
Set WSEntries = Sheets("Errors")

Dim LastRowErrorsSum As Integer
LastRowErrorsSum = WSEntries.Cells(Rows.Count, "A").End(xlUp).Row

Dim i As Integer
i = 1
For Each C In mRange
    WSEntries.Cells(LastRowErrorsSum + 1, i) = C
    i = i + 1
Next

End Sub

МОЯ ПРОБЛЕМА: Как вы можете видеть, этот последний код не копирует данные в последнюю строкудиапазон "D5: N", чтобы вставить его в мой лист ошибок в нужном мне порядке.

МОЙ ВОПРОС: Как я могу объединить эти коды, чтобы сделать следующее:

1- Копироватьдиапазон «D5: N» до последней строки, и для каждой строки данных скопируйте диапазон «B8» (для каждой строки).

2- Вставьте данные в «Лист ошибок», чтобы получить такой результат:

Ожидаемые результаты

Любое предложение будет оценено.

Надеюсь, я объяснил себя правильно, если нет, то извиняюсь.

Заранее спасибо!