主表将特定行复制到相应的表

Question

我在 EXCEL 2013 上有一张工作表，其中包含所有学生姓名和成绩的 MASTER SHEET 。我创建了一个表格，学生名称位于 A列，其期间（班级）位于列BH 。我的工作表底部选项卡上标有案例工作者姓名，以及他们在工作表中跟踪的学生列表。

以下是某人给我的示例代码无效：

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
Application.EnableEvents = False

If Intersect(Target, Columns("A:A")) Is Nothing Then Exit Sub
Target.EntireRow.Copy Sheets(Target.Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

以下是我的工作表示例：

MASTER SHEET TAB

Column A row 1: Name 
Column B row 1: Period 1
Column C row 1: Period 2
Column D row 1: Period 3
Column E row 1: Period 4
Column F row 1: Period 5
Column G row 1: Period 6
Column H row 1: 7

Column A row 2: Skywalker, Luke (example)
Column B row 2: F1, GUITAR
Column C row 2: C, HEALTH
Column D row 2: B, GEOMETRY
Column E row 2: A, YR1 ALGEBRA1
Column F row 2: C+, US HISTORY
Column G row 2: B, ENGLISH
Column H row 2: (BLANK)

ELIZABETH（SHEET）

与上述格式相同。

将学生从母版复制到工作表上的相应名称。

这可能更容易从单独的工作表中添加信息并将它们合并到主文件中。

Answer 1

OP表示工作表是以学生的Caseworkers命名的，而Caseworkers选项卡则列出了他们跟踪的学生名单。因此，您实际需要做的是搜索每个工作表中的学生姓名，然后更新他们的课程安排。

注意：这假定学生姓名列在案件工作者工作表的A栏中。

批量学生

如果您想一次处理所有学生，这将有效。

Sub ProcessStudents()
    Application.ScreenUpdating = False

    Const MASTERSHEETNAME As String = "MASTER SHEET"
    Dim cell As Range, ws As Worksheet
    Dim students As Object
    Set students = CreateObject("Scripting.Dictionary")

    With ThisWorkbook.Worksheets(MASTERSHEETNAME)
        For Each cell In .Range("A2", .Range("A" & .Row.Count).End(xlUp))
            If Not students.Exists(cell.Value) Then students.Add cell.Value, cell.Offset(0, 1).Resize(1, 7).Value
        Next
    End With

    For Each ws In ThisWorkbook.Worksheets
        With ws
            If UCase(ws.Name) <> UCase(MASTERSHEETNAME) Then
                For Each cell In .Range("A2", .Range("A" & .Row.Count).End(xlUp))
                    If students.Exists(cell.Value) Then students.Add cell.Offset(0, 1).Resize(1, 7).Value = students(cell.Value)
                Next
            End If
        End With
    Next

    Application.ScreenUpdating = True
End Sub

使用Worksheet_Change事件更新

更新学生的时间表正在更改。

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    If Not Intersect(Target, Range("H2", Range("A" & Row.Count).End(xlUp))) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub

    If Cells(Target.Row, 1) <> "" Then ProcessStudent Cells(Target.Row, 1)

    Application.ScreenUpdating = True
End Sub

Sub ProcessStudent(Target As Range)
    Dim cell As Range
    Dim students As Object
    Set students = CreateObject("System.Collections.ArrayList")

     For Each ws In ThisWorkbook.Worksheets
        With ws
            If ws.Name <> Target.Parent.Name Then
                Set cell = .Find(What:=FindString, After:=.Cells(.Cells.Count), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                If Not cell Is Nothing Then
                    cell.Resize(1, 8).Value = Target.Resize(1, 8).Value
                End If
                Exit For
            End If
        End With
    Next
End Sub