将多个工作表中的范围复制到一个工作表中，在第一个空单元格中答案

【问题标题】：Copy ranges from multiple worksheets into one worksheet, in first empty cell将多个工作表中的范围复制到一个工作表中，在第一个空单元格中
【发布时间】：2017-11-02 20:22:59
【问题描述】：

所以我想做的如下：

我有一个工作簿，其中包含 2 个包含一般信息的工作表，然后是 30 个包含学生信息（学生编号、姓名、成绩、最终工作组平均数）的工作表，然后是一个概览表（“Overzicht-OSC”）。

我要做的是仅复制学生编号（在 C 列中）和最终工作组平均值（在 L 列中），然后将这些值粘贴到我的概览表（“Overzicht-OSC”）中。所有工作组最多包含 25 名学生；通常更少，并且每个组的数量不同。所以我想要的是将第一组的数字（在表 3 中）粘贴到“Overzicht-OSC”中，然后将第二组的数字（在表 4 中）粘贴到该信息下方，等等，这样就可以最终概览中只会显示学生编号和成绩，跳过空白单元格。

我为此编写了以下代码：

Sub Overview()

Dim I As Integer
Dim sourceCol As Integer, rowCount As Integer, currentRow As Integer
Dim currentRowValue As String

For I = 3 To 32

    Range("B8:B34,L8:L34").Copy
    Sheets("Overzicht-OSC").Select

        sourceCol = 1
        rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row

        For currentRow = 1 To rowCount
            currentRowValue = Cells(currentRow, sourceCol).Value
            If IsEmpty(currentRowValue) Then
                Cells(currentRow, sourceCol).Select
                Exit For
            End If
        Next

    ActiveCell.PasteSpecial Paste:=xlPasteValues

Next I

End Sub

但它不起作用！我不断收到各种错误消息。使用上面编写的版本，我得到“Range 类的PasteSpecial 方法失败”。

当我将“ActiveCell.PasteSpecial”更改为“Selection.PasteSpecial”时，我得到“此选择无效。确保复制和粘贴区域不重叠，除非它们的大小和形状相同。

我之前也尝试过不同的代码：

Sub Overzicht2()

Dim I As Integer

For I = 3 To 32

    Range("C8:C34,L8:L34").Select
    Selection.Copy
    Sheets("Overzicht-OSC").Select
    Application.Goto Cells(Rows.Count, "A").End(xlUp).Offset(1), Scroll:=True
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Next I

End Sub

这不会给出错误消息，但也不起作用。

我应该如何解决这个问题？

【问题讨论】：

标签： vba excel loops

【解决方案1】：

您没有在代码中的任何位置引用工作表，并且不建议使用 ActiveCell，因为不清楚哪个单元格处于活动状态。也许这会起作用，尽管我也对使用很容易更改的工作表索引持谨慎态度 - 最好使用工作表名称或代码名称。

Sub Overzicht2()

Dim I As Long

For I = 3 To 32
    Sheets(I).Range("C8:C34,L8:L34").Copy
    Sheets("Overzicht-OSC").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Next I

End Sub

【讨论】：