循环工作表并将值复制到范围

Question

我正在尝试遍历所有工作表（前两个除外），从每个工作表中复制一个值，然后将复制的值放入一列中。 这就是我到目前为止所拥有的。 它没有给我一条错误消息，但它也不起作用。

Sub copyGrades()
    Dim ws As Excel.Worksheet
    Dim grade As Double

    Dim rng As Range
    Dim rcell As Range
    Set rng = ThisWorkbook.Worksheets("Student List").Range("H2:H174")

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "Rubric" And ws.Name <> "Student List" Then
            grade = ws.Range("E11").Value

            For Each rcell In rng.Cells
                rcell.Value = grade
            Next rcell

        End If
    Next ws
End Sub

Answer 1

我认为这就是我的做法（当然不是唯一的方法）：

Option Explicit

Sub copyGrades()
    Dim ws As Excel.Worksheet
    Dim grade As Double
    Dim rng As Range
    Dim count As Integer

    count = 1
    Set rng = ThisWorkbook.Worksheets("Student List").Range("H2:H174")

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "Rubric" And ws.Name <> "Student List" Then
            grade = ws.Range("E11").Value
            rng.Cells(count, 1) = grade
            count = count + 1
        End If
    Next
End Sub

Answer 2

我无法让嵌套循环工作，但我能够使用另一种方法解决它（在工作表名称和给定列中的值之间寻找匹配）。

Sub copyGrades()

    Dim ws As Excel.Worksheet
    Dim rng As Range
    Dim rcell As Range
    Set rng = ThisWorkbook.Worksheets("Student List").Range("F2:F174")

            For Each rcell In rng.Cells

                For Each ws In ActiveWorkbook.Worksheets
                    If ws.Name = rcell.Value Then
                        rcell.Offset(0, 3).Value = ws.Range("E11").Value
                    End If
                Next ws

            Next rcell
End Sub