2个Excel VBA宏：一个用于将数据从母版图纸移动到单独的图纸中，另一个用于将更新的数据从单独的图纸移动到母版图纸中

为了给问题提供一些背景，我尝试创建一个集中的主问答工作表，然后将问题分配给不同的人。提供给人们的电子表格只会显示分配给他们的问题

例如，这将是初始主电子表格，其中包含未回答的问题

# Allocation Question Answer
1 A          ABC
2 A          DEF
3 B          GHI
4 A          JKL
5 C          MNO
6 B          PQR

但是，人员A只会收到以下内容，并在将其发送回主工作表进行合并之前填写答案栏

# Allocation Question Answer
1 A          ABC
2 A          DEF
4 A          JKL

正如标题所示，我在尝试创建宏以执行以下操作时遇到了一些困难：

• 将整个表作为值复制到每个指定答案的单独选项卡中（即，一个名为a的选项卡，上面只有第二个表，然后是选项卡B和选项卡C，等等）
• 一旦指定的答案填充了他们自己的工作表，他们会将其发送回，然后需要一个宏来填充主工作表，现在填写答案

感谢这似乎是很多，但如果有人曾经做过这样的事情，如果是这样的话，能帮上忙，我会很高兴的

事先多谢

---

在。

发布您尝试过的代码。我承认，由于我对VBA非常陌生，因此无法一起工作。支持哪种版本？查看如何从题库生成试卷。

Sub MoveMasterData()

'Check each date
For Each Allocation In Worksheets("Master").Columns(2).Cells    'Change Master to your sheet name
    If Allocation.Value = "" Then Exit Sub 'Stop program if no data

    If Allocation.Row > 1 Then
        shtName = Allocation.Value    'Assign sheet name

        On Error GoTo errorhandler  'if no allocation Sheet, go to errorhandler to create new tab
        If Worksheets(shtName).Range("A2").Value = "" Then
           Allocation.EntireRow.Copy Destination:=Worksheets(shtName).Range("A2")
           Worksheets(shtName).Range("A1:D1").Columns.AutoFit
        Else
            Allocation.EntireRow.Copy Destination:=Worksheets(shtName).Range("A1").End(xlDown).Offset(1)
        End If
    End If
Next

Exit Sub
errorhandler:
Sheets.Add After:=Sheets(Sheets.Count) 'Create new tab
ActiveSheet.Name = shtName  'Name tab with Allocation
Worksheets("Master").Rows(1).EntireRow.Copy Destination:=ActiveSheet.Rows(1) 'Copy heading to new tab
Resume

End Sub

Sub CompileMaster()

'Check each Allocation
For Each Allocation In Worksheets("Master").Columns(2).Cells    'Change Master to your sheet name
    If Allocation.Value = "" Then Exit Sub 'Stop program if no data

    If Allocation.Row > 1 Then
        For Each sht In Worksheets
            If Allocation.Value = sht.Name Then
                For Each QNo In sht.Columns(1).Cells
                    If QNo.Value = "" Then Exit For 'Stop program if no data

                    RowQ = WorksheetFunction.Match(QNo, Worksheets("Master").Columns(1), 0) 'Check & Assign Question No
                    Worksheets("Master").Range("D" & RowQ).Value = QNo.Offset(0, 3).Value   'Transfer answer to master
                Next
            End If
        Next
    End If
Next

End Sub