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

遍历工作表并将值复制到范围

2 个答案: