Question

我有一个宏，我在其中加载了多个文件，复制每个文件的第一张纸并将其放入“主”文件中。

从此处开始，宏将创建所有新表的摘要，这些摘要已加载到称为“摘要”的预定义表中，并对另一个名为“错误”的表也是如此。

我将与“错误”页面共享代码，因为这是我的问题所在（这部分代码尚未复制和粘贴多个范围）：

您可以看到，此代码将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

现在，我意识到我还需要复制一个附加范围，这里是一个示例：

Source data

黄色范围是我现在要复制的范围，没有问题，但是我将需要复制粉红色的范围/单元格，不要按以下顺序粘贴到“错误”表中：

Errors Sheet

为此，我有这段代码，可以完美地工作（我保证我会回答我的问题）

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-将数据粘贴到“错误表”中以达到以下结果：

Expected Results

任何建议将不胜感激。

我希望我能正确解释自己，否则，我表示歉意。

谢谢！

复制多个范围并将其粘贴到同一行和最后一个空白行中的不同工作表上

0 个答案: